diff options
-rw-r--r-- | Artistic | 10 | ||||
-rwxr-xr-x | Bugs/assignglob | 34 | ||||
-rwxr-xr-x | Bugs/crash1 | 23 | ||||
-rw-r--r-- | Bugs/crash2 | 1 | ||||
-rwxr-xr-x[-rw-r--r--] | Bugs/pagdir | 0 | ||||
-rw-r--r-- | Bugs/replacecase | 1 | ||||
-rwxr-xr-x | Bugs/shiftref | 1 | ||||
-rw-r--r-- | Bugs/stuff | 64 | ||||
-rw-r--r-- | Changes | 83 | ||||
-rw-r--r-- | MANIFEST | 2 | ||||
-rw-r--r-- | NDBM_File.c | 267 | ||||
-rw-r--r-- | ODBM_File.c | 246 | ||||
-rw-r--r-- | SDBM_File.c | 266 | ||||
-rwxr-xr-x | Todo | 88 | ||||
-rw-r--r-- | Wishlist | 10 | ||||
-rw-r--r-- | XSUB.h | 1 | ||||
-rw-r--r-- | av.c | 292 | ||||
-rw-r--r-- | av.h | 16 | ||||
-rwxr-xr-x | bar | 8 | ||||
-rw-r--r-- | config.sh | 4 | ||||
-rw-r--r-- | cop.h | 8 | ||||
-rw-r--r-- | deb.c | 4 | ||||
-rw-r--r-- | do/accept | 51 | ||||
-rw-r--r-- | do/aexec | 34 | ||||
-rw-r--r-- | do/aprint | 41 | ||||
-rw-r--r-- | do/assign | 201 | ||||
-rw-r--r-- | do/bind | 31 | ||||
-rw-r--r-- | do/caller | 67 | ||||
-rw-r--r-- | do/chop | 40 | ||||
-rw-r--r-- | do/close | 45 | ||||
-rw-r--r-- | do/connect | 29 | ||||
-rw-r--r-- | do/ctl | 72 | ||||
-rw-r--r-- | do/defined | 42 | ||||
-rw-r--r-- | do/dirop | 101 | ||||
-rw-r--r-- | do/each | 33 | ||||
-rw-r--r-- | do/eof | 45 | ||||
-rw-r--r-- | do/exec | 77 | ||||
-rw-r--r-- | do/execfree | 13 | ||||
-rw-r--r-- | do/fttext | 94 | ||||
-rw-r--r-- | do/getsockname | 45 | ||||
-rw-r--r-- | do/ggrent | 61 | ||||
-rw-r--r-- | do/ghent | 92 | ||||
-rw-r--r-- | do/gnent | 64 | ||||
-rw-r--r-- | do/gpent | 61 | ||||
-rw-r--r-- | do/gpwent | 86 | ||||
-rw-r--r-- | do/grep | 49 | ||||
-rw-r--r-- | do/gsent | 77 | ||||
-rw-r--r-- | do/ipcctl | 103 | ||||
-rw-r--r-- | do/ipcget | 36 | ||||
-rw-r--r-- | do/join | 45 | ||||
-rw-r--r-- | do/kv | 56 | ||||
-rw-r--r-- | do/listen | 27 | ||||
-rw-r--r-- | do/match | 288 | ||||
-rw-r--r-- | do/msgrcv | 34 | ||||
-rw-r--r-- | do/msgsnd | 26 | ||||
-rw-r--r-- | do/open | 239 | ||||
-rw-r--r-- | do/pack | 399 | ||||
-rw-r--r-- | do/pipe | 52 | ||||
-rw-r--r-- | do/print | 37 | ||||
-rw-r--r-- | do/push | 19 | ||||
-rw-r--r-- | do/range | 43 | ||||
-rw-r--r-- | do/repeatary | 25 | ||||
-rw-r--r-- | do/reverse | 19 | ||||
-rw-r--r-- | do/seek | 29 | ||||
-rw-r--r-- | do/select | 133 | ||||
-rw-r--r-- | do/semop | 27 | ||||
-rw-r--r-- | do/shmio | 55 | ||||
-rw-r--r-- | do/shutdown | 28 | ||||
-rw-r--r-- | do/slice | 96 | ||||
-rw-r--r-- | do/socket | 42 | ||||
-rw-r--r-- | do/sopt | 51 | ||||
-rw-r--r-- | do/sort | 102 | ||||
-rw-r--r-- | do/spair | 56 | ||||
-rw-r--r-- | do/splice | 192 | ||||
-rw-r--r-- | do/split | 235 | ||||
-rw-r--r-- | do/sprintf | 197 | ||||
-rw-r--r-- | do/sreverse | 25 | ||||
-rw-r--r-- | do/stat | 95 | ||||
-rw-r--r-- | do/study | 73 | ||||
-rw-r--r-- | do/subr | 91 | ||||
-rw-r--r-- | do/subst | 269 | ||||
-rw-r--r-- | do/syscall | 99 | ||||
-rw-r--r-- | do/tell | 27 | ||||
-rw-r--r-- | do/time | 29 | ||||
-rw-r--r-- | do/tms | 41 | ||||
-rw-r--r-- | do/trans | 58 | ||||
-rw-r--r-- | do/truncate | 55 | ||||
-rw-r--r-- | do/undef | 59 | ||||
-rw-r--r-- | do/unpack | 561 | ||||
-rw-r--r-- | do/unshift | 20 | ||||
-rw-r--r-- | do/vec | 58 | ||||
-rw-r--r-- | do/vecset | 40 | ||||
-rw-r--r-- | do/vop | 50 | ||||
-rw-r--r-- | doio.c | 243 | ||||
-rw-r--r-- | dolist.c | 117 | ||||
-rw-r--r-- | doop.c | 169 | ||||
-rw-r--r-- | doop.c2 | 571 | ||||
-rw-r--r-- | dump.c | 36 | ||||
-rw-r--r-- | emacs/cperl-mode | 710 | ||||
-rw-r--r-- | emacs/emacs19 | 312 | ||||
-rw-r--r-- | embed.h | 785 | ||||
-rwxr-xr-x | embed_h.SH | 12 | ||||
-rw-r--r-- | ext/README (renamed from usub/README) | 0 | ||||
-rw-r--r-- | ext/curses/Makefile (renamed from usub/Makefile) | 0 | ||||
-rw-r--r-- | ext/curses/bsdcurses.mus (renamed from usub/bsdcurses.mus) | 0 | ||||
-rw-r--r-- | ext/curses/curses.mus (renamed from usub/curses.mus) | 0 | ||||
-rw-r--r-- | ext/curses/pager (renamed from usub/pager) | 0 | ||||
-rw-r--r-- | ext/dbm/GDBM_File.c | 310 | ||||
-rw-r--r-- | ext/dbm/GDBM_File.xs | 76 | ||||
-rw-r--r-- | ext/dbm/GDBM_File.xs.bak | 122 | ||||
-rw-r--r-- | ext/dbm/Makefile | 14 | ||||
-rw-r--r-- | ext/dbm/NDBM_File.c | 267 | ||||
-rw-r--r-- | ext/dbm/NDBM_File.xs | 58 | ||||
-rw-r--r-- | ext/dbm/ODBM_File.c | 246 | ||||
-rw-r--r-- | ext/dbm/ODBM_File.xs | 86 | ||||
-rw-r--r-- | ext/dbm/SDBM_File.c | 266 | ||||
-rw-r--r-- | ext/dbm/SDBM_File.xs | 57 | ||||
-rw-r--r-- | ext/dbm/sdbm/.pure | 0 | ||||
-rwxr-xr-x | ext/dbm/sdbm/.r | 5884 | ||||
-rw-r--r-- | ext/dbm/sdbm/CHANGES | 18 | ||||
-rw-r--r-- | ext/dbm/sdbm/COMPARE | 88 | ||||
-rw-r--r-- | ext/dbm/sdbm/README | 396 | ||||
-rw-r--r-- | ext/dbm/sdbm/README.too | 3 | ||||
-rw-r--r-- | ext/dbm/sdbm/biblio | 64 | ||||
-rw-r--r-- | ext/dbm/sdbm/dba.c | 84 | ||||
-rw-r--r-- | ext/dbm/sdbm/dbd.c | 110 | ||||
-rw-r--r-- | ext/dbm/sdbm/dbe.1 | 46 | ||||
-rw-r--r-- | ext/dbm/sdbm/dbe.c | 435 | ||||
-rw-r--r-- | ext/dbm/sdbm/dbm.c | 120 | ||||
-rw-r--r-- | ext/dbm/sdbm/dbm.h | 33 | ||||
-rw-r--r-- | ext/dbm/sdbm/dbu.c | 250 | ||||
-rwxr-xr-x | ext/dbm/sdbm/grind | 9 | ||||
-rw-r--r-- | ext/dbm/sdbm/hash.c | 47 | ||||
-rw-r--r-- | ext/dbm/sdbm/linux.patches | 67 | ||||
-rw-r--r-- | ext/dbm/sdbm/makefile | 55 | ||||
-rw-r--r-- | ext/dbm/sdbm/pair.c | 308 | ||||
-rw-r--r-- | ext/dbm/sdbm/pair.h | 10 | ||||
-rw-r--r-- | ext/dbm/sdbm/readme.ms | 353 | ||||
-rw-r--r-- | ext/dbm/sdbm/readme.ps | 2225 | ||||
-rw-r--r-- | ext/dbm/sdbm/sdbm.3 | 290 | ||||
-rw-r--r-- | ext/dbm/sdbm/sdbm.c | 524 | ||||
-rw-r--r-- | ext/dbm/sdbm/sdbm.h | 91 | ||||
-rw-r--r-- | ext/dbm/sdbm/tune.h | 34 | ||||
-rw-r--r-- | ext/dbm/sdbm/util.c | 50 | ||||
-rw-r--r-- | ext/man2mus (renamed from usub/man2mus) | 0 | ||||
-rw-r--r-- | ext/mus (renamed from usub/mus) | 0 | ||||
-rw-r--r-- | ext/posix/POSIX.xs | 10 | ||||
-rw-r--r-- | ext/typemap (renamed from usub/typemap) | 13 | ||||
-rwxr-xr-x | ext/xsubpp (renamed from usub/tus) | 181 | ||||
-rwxr-xr-x | ext/xsubpp.bak | 529 | ||||
-rwxr-xr-x | ext/xvarpp (renamed from usub/tuv) | 22 | ||||
-rwxr-xr-x | fixmac | 11 | ||||
-rwxr-xr-x | fo | 179 | ||||
-rwxr-xr-x | foo | 5 | ||||
-rw-r--r-- | functab.h,v | 2854 | ||||
-rw-r--r-- | global.var | 768 | ||||
-rw-r--r-- | gv.c | 325 | ||||
-rw-r--r-- | gv.h | 3 | ||||
-rwxr-xr-x | h2ph | 10 | ||||
-rw-r--r-- | hints/aix_rs.sh | 8 | ||||
-rw-r--r-- | hv.c | 546 | ||||
-rw-r--r-- | hv.h | 41 | ||||
-rw-r--r-- | hvdbm.h | 58 | ||||
-rw-r--r-- | interp.var | 3 | ||||
-rw-r--r-- | keywords.h | 438 | ||||
-rw-r--r-- | lib/hostname.pl | 23 | ||||
-rw-r--r-- | lib/open3.pl | 2 | ||||
-rw-r--r-- | lib/timelocal.pl | 1 | ||||
-rw-r--r-- | lib/verbose.pl | 78 | ||||
-rw-r--r-- | main.c | 27 | ||||
-rw-r--r-- | make.out | 12 | ||||
-rw-r--r-- | makefile | 266 | ||||
-rw-r--r-- | malloc.c | 4 | ||||
-rw-r--r-- | mg.c | 407 | ||||
-rw-r--r-- | mg.h | 2 | ||||
l--------- | net | 1 | ||||
-rw-r--r-- | op.c | 565 | ||||
-rw-r--r-- | op.h | 1 | ||||
-rw-r--r-- | opcode.h | 1238 | ||||
-rwxr-xr-x | opcode.pl | 18 | ||||
-rw-r--r-- | perl.c | 252 | ||||
-rw-r--r-- | perl.h | 195 | ||||
-rw-r--r-- | perl.man | 150 | ||||
-rw-r--r-- | perly.c | 2824 | ||||
-rw-r--r-- | perly.h | 34 | ||||
-rw-r--r-- | perly.y | 96 | ||||
-rw-r--r-- | pp.c | 1051 | ||||
-rw-r--r-- | pp.h | 18 | ||||
-rw-r--r-- | proto.h | 102 | ||||
-rw-r--r-- | regcomp.c | 18 | ||||
-rw-r--r-- | regcomp.h | 2 | ||||
-rw-r--r-- | regexec.c | 6 | ||||
-rw-r--r-- | run.c | 2 | ||||
-rw-r--r-- | scope.c | 12 | ||||
-rw-r--r-- | sv.c | 1396 | ||||
-rw-r--r-- | sv.h | 184 | ||||
-rwxr-xr-x | t/comp/cmdopt.t | 18 | ||||
-rwxr-xr-x | t/comp/package.t | 10 | ||||
-rwxr-xr-x | t/op/dbm.t | 10 | ||||
-rwxr-xr-x | t/op/ord.t | 4 | ||||
-rwxr-xr-x | t/op/sort.t | 6 | ||||
-rwxr-xr-x | t/op/time.t | 2 | ||||
-rwxr-xr-x | t/op/write.t | 2 | ||||
-rw-r--r-- | taint.c | 62 | ||||
-rwxr-xr-x | tiearray | 26 | ||||
-rwxr-xr-x | tiedbm | 34 | ||||
-rwxr-xr-x | tiescalar | 20 | ||||
-rw-r--r-- | toke.c | 784 | ||||
-rw-r--r-- | usersub.c | 8 | ||||
-rw-r--r-- | usub/usersub.c | 74 | ||||
-rw-r--r-- | util.c | 83 | ||||
-rw-r--r-- | x2p/a2p.y | 2 | ||||
-rwxr-xr-x | x2p/find2perl.SH | 2 |
213 files changed, 24451 insertions, 15059 deletions
@@ -115,10 +115,16 @@ equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. -8. The name of the Copyright Holder may not be used to endorse or promote +8. Aggregation of this Package with a commercial distribution is always +permitted provided that the use of this Package is embedded; that is, +when no overt attempt is made to make this Package's interfaces visible +to the end user of the commercial distribution. Such use shall not be +construed as a distribution of this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. -9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. diff --git a/Bugs/assignglob b/Bugs/assignglob deleted file mode 100755 index f36e9e2150..0000000000 --- a/Bugs/assignglob +++ /dev/null @@ -1,34 +0,0 @@ -#!./perl - -#!/usr/bin/perl -$month = (split(' ',`date`))[1]; - -while (<DATA>) { - next if 1 .. ?^$month\b?o; - next unless /deposit/; - ($day) = /(\d+)/; - local(*where) = m:([^/]+)$:; - # with the local, you get bad free's. with it, you get a core dump - $where{$day}++; -} - -@days = sort { $a <=> $b } keys %personal; - -foreach $place ('tivoli', 'lists', 'personal') { - *where = $place; - foreach $day (@days) { - printf "Aug %02d: %3d in %s\n", $day, $where{$day}, $place; - } -} - -__END__ -Aug 27 10:40:20 New mail from hess -Aug 27 10:40:20 deposit into /home/wraeththu/tchrist/Mail/in.coming/tivoli -Aug 27 10:42:27 New mail from jcarson -Aug 27 10:42:27 deposit into /home/wraeththu/tchrist/Mail/in.coming/tivoli -Aug 27 10:48:18 New mail from dean -Aug 27 10:48:18 deposit into /home/wraeththu/tchrist/Mail/in.coming/tivoli -Aug 27 11:05:56 New mail from hess -Aug 27 11:05:56 deposit into personal -Aug 27 11:13:28 New mail from hess -Aug 27 11:13:28 deposit into personal diff --git a/Bugs/crash1 b/Bugs/crash1 deleted file mode 100755 index 7e6eff7942..0000000000 --- a/Bugs/crash1 +++ /dev/null @@ -1,23 +0,0 @@ -#!./perl -# These filenames doesn't seem to matter, as long as the first one exists, -# and we have permission to create the second one. -open(OLD_FILE, "/etc/passwd"); -open(NEW_FILE, ">/tmp/foobar"); - -# This line is unnecessary to trigger death, but it helps to show where -# we crash and burn. -$| = 1; - -# Seemingly, this loop is necessary to activate the bug. If I just say -# $_ = <OLD_FILE> -# instead of the loop, everything works as expected. -while (<OLD_FILE>) { - # This was originally just a random typing spaz on my part, but it causes - # perl to crash later. - print <NEW_FILE>; -} - -print "About to die...\n"; -print "dest = '$dest'\n"; -print "Didn't die!\n"; - diff --git a/Bugs/crash2 b/Bugs/crash2 deleted file mode 100644 index c726e2ef3b..0000000000 --- a/Bugs/crash2 +++ /dev/null @@ -1 +0,0 @@ -sleep(1) &sort diff --git a/Bugs/pagdir b/Bugs/pagdir index 7cc76f2b51..7cc76f2b51 100644..100755 --- a/Bugs/pagdir +++ b/Bugs/pagdir diff --git a/Bugs/replacecase b/Bugs/replacecase deleted file mode 100644 index 795ea9db46..0000000000 --- a/Bugs/replacecase +++ /dev/null @@ -1 +0,0 @@ -s/\w/[\u$&\l$&]/gi; diff --git a/Bugs/shiftref b/Bugs/shiftref new file mode 100755 index 0000000000..e4ab0c58b9 --- /dev/null +++ b/Bugs/shiftref @@ -0,0 +1 @@ +shift->[0] diff --git a/Bugs/stuff b/Bugs/stuff deleted file mode 100644 index 3337af01e2..0000000000 --- a/Bugs/stuff +++ /dev/null @@ -1,64 +0,0 @@ -Article 13355 of comp.lang.perl: -Newsgroups: comp.lang.perl -Path: netlabs!news.cerf.net!usc!cs.utexas.edu!uunet!fmrco!fmrco!asherman -From: asherman@fmrco.com (Aaron Sherman) -Subject: Re: perl 5a2 cannot "die" (plus current list o' bugs) -In-Reply-To: wjm@feenix.metronet.com's message of Fri, 20 Aug 1993 21:32:10 GMT -Message-ID: <ASHERMAN.93Aug23094250@uboat.fmrco.com> -Sender: news@fmrco.uucp -X-Quote: "...accepting is much harder than giving." -Mike Smith -Reply-To: asherman@fmrco.COM -Organization: I-Kinetics, 19 Bishop-Allen Dr., Cambridge, MA -References: <ASHERMAN.93Aug20102959@uboat.fmrco.com> <CC2uHM.6Hq@feenix.metronet.com> -Date: Mon, 23 Aug 1993 14:42:50 GMT -Lines: 47 - - ->>>>> wjm@feenix.metronet.com (Bill Middleton) said: - -wjm> asherman@fmrco.COM writes: - ->An interesting pair of bugs can be seen in the following output: - -wjm> I dont think so. Could be in the compilation or something. Did it -wjm> pass all tests? Each of the following work fine here on this HP. - -I tried compiling with Sun's native CC and GCC. Both worked fine, but -caused this problem. I'll try it with Larry's original version when I -get a chance. - -wjm> perl5 -e 'die "hello $. \n"; -wjm> hello - -Ah. But, note that the $. STILL isn't working. So only ONE of those -bugs did not show. - -This is my current list of bugs (not complete, but what I've had time -to note). Hope it helps: - -"perl -e die" will cause a seg-fault - -$. is not updated - -Memory leak for anonymous arrays: - while(1) { @a = (1, 2, 3, [4, 5], 6); @a = (); } - Will keep allocating and not freeing memory. - -"perl -e 'sub foo {print 1} foo'" should either complain or call foo, - but does neither. Or, did Larry not impliment the &-less - function calling that he was talking about? - -"perl -le 'sub foo {1} $a = \&foo; print &{$a}; print &{$a} + 1'" should - not fail to parse. - - - -AJS - --- -Aaron Sherman I-Kinetics, Inc. -Systems Engineer "Open Systems Stepstones" -Voice: (617)661-8181 19 Bishop Allen Dr. -Fax: (617)661-8625 Cambridge, MA 02139 -Pager: (508)545-0584 asherman@i-kinetics.com - - @@ -1,36 +1,9 @@ -Incompatibilities ------------------ - s'$lhs'$rhs' now does no interpolation on either side. It used to - interplolate $lhs but not $rhs. - - The second and third arguments of splice are now evaluated in scalar - context (like the book says) rather than list context. - - Saying "shift @foo + 20" is now a semantic error because of precedence. - - "open FOO || die" is now incorrect. You need parens around the filehandle. - - The elements of argument lists for formats are now evaluated in list - context. This means you can interpolate list values now. - - You can't do a goto into a block that is optimized away. Darn. - - It is no longer syntactically legal to use whitespace as the name - of a variable. - - Some error messages will be different. - - The caller function now a false value in a scalar context if there is - no caller. This lets library files determine if they're being required. - - m//g now attaches its state to the searched string rather than the - regular expression. - New things ---------- The -w switch is much more informative. - References. See t/op/ref.t for examples. + References. See t/op/ref.t for examples. All entities in Perl 5 are + reference counted so that it knows when each item should be destroyed. Objects. See t/op/ref.t for examples. @@ -42,7 +15,9 @@ New things meaning the parens are optional. Even subroutines may be called as list operators if they've already been declared. - More embeddible. See main.c and embed_h.SH. + More embeddible. See main.c and embed_h.SH. Multiple interpreters + in the same process are supported (though not with interleaved + execution yet). The interpreter is now flattened out. Compare Perl 4's eval.c with the perl 5's pp.c. Compare Perl 4's 900 line interpreter loop in cmd.c @@ -73,3 +48,51 @@ New things variables. Saying "package;" requires explicit package name on global symbols. + + The preferred package delimiter is now :: rather than '. + + tie/untie are now preferred to dbmopen/dbmclose. Multiple DBM + implementations are allowed in the same executable, so you can + write scripts to interchange data among different formats. + + New "and" and "or" operators work just like && and || but with + a precedence lower than comma, so they work better with list operators. + + New functions include: abs(), chr(), uc(), ucfirst(), lc(), lcfirst() + +Incompatibilities +----------------- + @ now always interpolates an array in double-quotish strings. Some programs + may now need to use backslash to protect any @ that shouldn't interpolate. + + s'$lhs'$rhs' now does no interpolation on either side. It used to + interplolate $lhs but not $rhs. + + The second and third arguments of splice are now evaluated in scalar + context (like the book says) rather than list context. + + Saying "shift @foo + 20" is now a semantic error because of precedence. + + "open FOO || die" is now incorrect. You need parens around the filehandle. + + The elements of argument lists for formats are now evaluated in list + context. This means you can interpolate list values now. + + You can't do a goto into a block that is optimized away. Darn. + + It is no longer syntactically legal to use whitespace as the name + of a variable. + + Some error messages will be different. + + The caller function now returns a false value in a scalar context if there + is no caller. This lets library files determine if they're being required. + + m//g now attaches its state to the searched string rather than the + regular expression. + + "reverse" is no longer allowed as the name of a sort subroutine. + + taintperl is no longer a separate executable. There is now a -T + switch to turn on tainting when it isn't turned on automatically. + @@ -59,7 +59,7 @@ consarg.c Routines to construct arg nodes of a parse tree doSH Script to run all the *.SH files doarg.c Scalar expression evaluation doio.c I/O operations -dolist.c Array expression evaluation +doop.c Support code for various operations dosish.h dump.c Debugging output eg/ADB An adb wrapper to put in your crash dir diff --git a/NDBM_File.c b/NDBM_File.c new file mode 100644 index 0000000000..304053422a --- /dev/null +++ b/NDBM_File.c @@ -0,0 +1,267 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <ndbm.h> + +typedef DBM* NDBM_File; +#define dbm_new(dbtype,filename,flags,mode) dbm_open(filename,flags,mode) +#define nextkey(db,key) dbm_nextkey(db) + +static int +XS_NDBM_File_dbm_new(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 4 || items > 4) { + croak("Usage: NDBM_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)); + NDBM_File RETVAL; + + RETVAL = dbm_new(dbtype, filename, flags, mode); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setptrobj(ST(0), RETVAL, "NDBM_File"); + } + return sp; +} + +static int +XS_NDBM_File_dbm_DESTROY(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || 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))); + else + croak("db is not of type NDBM_File"); + dbm_close(db); + } + return sp; +} + +static int +XS_NDBM_File_dbm_fetch(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + croak("Usage: NDBM_File::fetch(db, key)"); + } + { + NDBM_File db; + datum key; + datum RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(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); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_NDBM_File_dbm_store(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 3 || items > 4) { + croak("Usage: NDBM_File::store(db, key, value, flags = DBM_REPLACE)"); + } + { + NDBM_File db; + datum key; + datum value; + int flags; + int RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + croak("db is not of type NDBM_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 = dbm_store(db, key, value, flags); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_NDBM_File_dbm_delete(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + croak("Usage: NDBM_File::delete(db, key)"); + } + { + NDBM_File db; + datum key; + int RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(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); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_NDBM_File_dbm_firstkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + croak("Usage: NDBM_File::firstkey(db)"); + } + { + NDBM_File db; + datum RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + croak("db is not of type NDBM_File"); + + RETVAL = dbm_firstkey(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_NDBM_File_nextkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + croak("Usage: NDBM_File::nextkey(db, key)"); + } + { + NDBM_File db; + datum key; + datum RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(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); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_NDBM_File_dbm_error(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + croak("Usage: NDBM_File::error(db)"); + } + { + NDBM_File db; + int RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + croak("db is not of type NDBM_File"); + + RETVAL = dbm_error(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_NDBM_File_dbm_clearerr(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + croak("Usage: NDBM_File::clearerr(db)"); + } + { + NDBM_File db; + int RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + croak("db is not of type NDBM_File"); + + RETVAL = dbm_clearerr(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +int init_NDBM_File(ix,sp,items) +int ix; +int sp; +int items; +{ + char* file = __FILE__; + + newXSUB("NDBM_File::new", 0, XS_NDBM_File_dbm_new, file); + newXSUB("NDBM_File::DESTROY", 0, XS_NDBM_File_dbm_DESTROY, file); + newXSUB("NDBM_File::fetch", 0, XS_NDBM_File_dbm_fetch, file); + newXSUB("NDBM_File::store", 0, XS_NDBM_File_dbm_store, file); + newXSUB("NDBM_File::delete", 0, XS_NDBM_File_dbm_delete, file); + newXSUB("NDBM_File::firstkey", 0, XS_NDBM_File_dbm_firstkey, file); + newXSUB("NDBM_File::nextkey", 0, XS_NDBM_File_nextkey, file); + newXSUB("NDBM_File::error", 0, XS_NDBM_File_dbm_error, file); + newXSUB("NDBM_File::clearerr", 0, XS_NDBM_File_dbm_clearerr, file); +} diff --git a/ODBM_File.c b/ODBM_File.c new file mode 100644 index 0000000000..7c5f780a2e --- /dev/null +++ b/ODBM_File.c @@ -0,0 +1,246 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifdef NULL +#undef NULL +#endif +#include <dbm.h> + +#include <fcntl.h> + +typedef void* ODBM_File; + +#define odbm_fetch(db,key) fetch(key) +#define odbm_store(db,key,value,flags) store(key,value) +#define odbm_delete(db,key) delete(key) +#define odbm_firstkey(db) firstkey() +#define odbm_nextkey(db,key) nextkey(key) + +static int dbmrefcnt; + +#define DBM_REPLACE 0 + +static int +XS_ODBM_File_odbm_new(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 4 || items > 4) { + croak("Usage: ODBM_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)); + ODBM_File RETVAL; + { + char tmpbuf[1025]; + if (dbmrefcnt++) + 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) + croak("ODBM_File: Can't create %s", filename); + sprintf(tmpbuf,"%s.pag",filename); + if (close(creat(tmpbuf,mode)) < 0) + croak("ODBM_File: Can't create %s", filename); + } + else + croak("ODBM_FILE: Can't open %s", filename); + } + RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setptrobj(ST(0), RETVAL, "ODBM_File"); + } + } + return sp; +} + +static int +XS_ODBM_File_DESTROY(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || 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))); + else + croak("db is not of type ODBM_File"); + dbmrefcnt--; + dbmclose(); + } + return sp; +} + +static int +XS_ODBM_File_odbm_fetch(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + croak("Usage: ODBM_File::fetch(db, key)"); + } + { + ODBM_File db; + datum key; + datum RETVAL; + + if (sv_isa(ST(1), "ODBM_File")) + db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(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); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_ODBM_File_odbm_store(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 3 || items > 4) { + croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)"); + } + { + ODBM_File db; + datum key; + datum value; + int flags; + int RETVAL; + + if (sv_isa(ST(1), "ODBM_File")) + db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + croak("db is not of type ODBM_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 = odbm_store(db, key, value, flags); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_ODBM_File_odbm_delete(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + croak("Usage: ODBM_File::delete(db, key)"); + } + { + ODBM_File db; + datum key; + int RETVAL; + + if (sv_isa(ST(1), "ODBM_File")) + db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(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); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_ODBM_File_odbm_firstkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + 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))); + else + croak("db is not of type ODBM_File"); + + RETVAL = odbm_firstkey(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_ODBM_File_odbm_nextkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + croak("Usage: ODBM_File::nextkey(db, key)"); + } + { + ODBM_File db; + datum key; + datum RETVAL; + + if (sv_isa(ST(1), "ODBM_File")) + db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(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); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +int init_ODBM_File(ix,sp,items) +int ix; +int sp; +int items; +{ + char* file = __FILE__; + + newXSUB("ODBM_File::new", 0, XS_ODBM_File_odbm_new, file); + newXSUB("ODBM_File::DESTROY", 0, XS_ODBM_File_DESTROY, file); + newXSUB("ODBM_File::fetch", 0, XS_ODBM_File_odbm_fetch, file); + newXSUB("ODBM_File::store", 0, XS_ODBM_File_odbm_store, file); + newXSUB("ODBM_File::delete", 0, XS_ODBM_File_odbm_delete, file); + newXSUB("ODBM_File::firstkey", 0, XS_ODBM_File_odbm_firstkey, file); + newXSUB("ODBM_File::nextkey", 0, XS_ODBM_File_odbm_nextkey, file); +} diff --git a/SDBM_File.c b/SDBM_File.c new file mode 100644 index 0000000000..23b8356f49 --- /dev/null +++ b/SDBM_File.c @@ -0,0 +1,266 @@ +#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) { + croak("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) { + croak("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 + croak("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) { + croak("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 + croak("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) { + croak("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 + croak("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) { + croak("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 + croak("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) { + croak("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 + croak("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) { + croak("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 + croak("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) { + croak("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 + croak("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) { + croak("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 + croak("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); +} @@ -1,31 +1,61 @@ -POSIX compatibility -hash binding -pack(P) -fix gv refcnts +Must-have external packages + POSIX + X/Motif/whatever -/\Afoo/ (beginning of string, or where previous g match left off) -/foo\Z/ (end of string only) -Make specialized allocators -Optimize switch statements -Optimize foreach on array -Optimize foreach (1..1000000) -Set KEEP on constant split -Cache eval tree (unless lexical outer scope used (mark in &compiling?)) -rcatmaybe -Cache method lookup -Shrink opcode tables via multiple implementations selected in peep -Straighten out the RS stuff in BEGIN -Make yyparse recursion longjmp() proof. +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"); -sub mysplice(@, $, $, ...)? -pretty function? (or is it, as I suspect, a lib routine?) -perlex function? -X Perl? Motif Perl? -give DOG $bone? -Nested destructors? -make tr/// return histogram in list context? -Implement eval once? (Unnecessary with cache?) -When does split() go to @_? -undef wantarray in void context? -goto &coroutine? -filehandle references? +Regexp extensions + /m for multiline + /\Afoo/ (beginning of string, or where previous g match left off) + /foo\Z/ (end of string only) + negative regexp assertions? + /<>/x for grouping? + /f for fixed variable interpolation? + Rewrite regexp parser for better integrated optimization + +Nice to have + Profiler + pack "(stuff)*" + lexperl + Bundled perl preprocessor + FILEHANDLE methods + +Optimizations + Make specialized allocators + Optimize switch statements + Optimize foreach on array + Optimize foreach (1..1000000) + Set KEEP on constant split + Cache eval tree (unless lexical outer scope used (mark in &compiling?)) + rcatmaybe + Shrink opcode tables via multiple implementations selected in peep + Cache hash value? + sfio? + +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? + +Vague possibilities + 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 + multi-thread scheduling + built-in globbing + compile to real threaded code + structured types diff --git a/Wishlist b/Wishlist deleted file mode 100644 index 4afb4f87cb..0000000000 --- a/Wishlist +++ /dev/null @@ -1,10 +0,0 @@ -built-in cpp -perl to C translator -multi-threading -make more easily embeddable -built-in globbing -compile to threaded code -rewrite regexp parser for better integrated optimization -add structured types and objects -allow for lexical scoping -delete current sub diff --git a/XSUB.h b/XSUB.h new file mode 100644 index 0000000000..764b8e6eab --- /dev/null +++ b/XSUB.h @@ -0,0 +1 @@ +#define ST(s) stack_base[sp + s] @@ -28,37 +28,52 @@ #include "perl.h" SV** -av_fetch(ar,key,lval) -register AV *ar; +av_fetch(av,key,lval) +register AV *av; I32 key; I32 lval; { SV *sv; - if (key < 0 || key > AvFILL(ar)) { + if (SvMAGICAL(av)) { + if (mg_find((SV*)av,'P')) { + if (key < 0) + return 0; + sv = sv_2mortal(NEWSV(61,0)); + mg_copy((SV*)av, sv, 0, key); + if (!lval) { + mg_get((SV*)sv); + sv_unmagic(sv,'p'); + } + Sv = sv; + return &Sv; + } + } + + if (key < 0 || key > AvFILL(av)) { if (lval && key >= 0) { - if (AvREAL(ar)) + if (AvREAL(av)) sv = NEWSV(5,0); else sv = sv_mortalcopy(&sv_undef); - return av_store(ar,key,sv); + return av_store(av,key,sv); } else return 0; } - if (!AvARRAY(ar)[key]) { + if (!AvARRAY(av)[key]) { if (lval) { sv = NEWSV(6,0); - return av_store(ar,key,sv); + return av_store(av,key,sv); } return 0; } - return &AvARRAY(ar)[key]; + return &AvARRAY(av)[key]; } SV** -av_store(ar,key,val) -register AV *ar; +av_store(av,key,val) +register AV *av; I32 key; SV *val; { @@ -67,42 +82,50 @@ SV *val; if (key < 0) return 0; - if (key > AvMAX(ar)) { + + if (SvMAGICAL(av)) { + if (mg_find((SV*)av,'P')) { + mg_copy((SV*)av, val, 0, key); + return 0; + } + } + + if (key > AvMAX(av)) { I32 newmax; - if (AvALLOC(ar) != AvARRAY(ar)) { - tmp = AvARRAY(ar) - AvALLOC(ar); - Move(AvARRAY(ar), AvALLOC(ar), AvMAX(ar)+1, SV*); - Zero(AvALLOC(ar)+AvMAX(ar)+1, tmp, SV*); - AvMAX(ar) += tmp; - AvARRAY(ar) -= tmp; - if (key > AvMAX(ar) - 10) { - newmax = key + AvMAX(ar); + if (AvALLOC(av) != AvARRAY(av)) { + tmp = AvARRAY(av) - AvALLOC(av); + Move(AvARRAY(av), AvALLOC(av), AvMAX(av)+1, SV*); + Zero(AvALLOC(av)+AvMAX(av)+1, tmp, SV*); + AvMAX(av) += tmp; + SvPVX(av) = (char*)(AvARRAY(av) - tmp); + if (key > AvMAX(av) - 10) { + newmax = key + AvMAX(av); goto resize; } } else { - if (AvALLOC(ar)) { - newmax = key + AvMAX(ar) / 5; + if (AvALLOC(av)) { + newmax = key + AvMAX(av) / 5; resize: - Renew(AvALLOC(ar),newmax+1, SV*); - Zero(&AvALLOC(ar)[AvMAX(ar)+1], newmax - AvMAX(ar), SV*); + Renew(AvALLOC(av),newmax+1, SV*); + Zero(&AvALLOC(av)[AvMAX(av)+1], newmax - AvMAX(av), SV*); } else { newmax = key < 4 ? 4 : key; - Newz(2,AvALLOC(ar), newmax+1, SV*); + Newz(2,AvALLOC(av), newmax+1, SV*); } - AvARRAY(ar) = AvALLOC(ar); - AvMAX(ar) = newmax; + SvPVX(av) = (char*)AvALLOC(av); + AvMAX(av) = newmax; } } - ary = AvARRAY(ar); - if (AvREAL(ar)) { - if (AvFILL(ar) < key) { - while (++AvFILL(ar) < key) { - if (ary[AvFILL(ar)] != Nullsv) { - sv_free(ary[AvFILL(ar)]); - ary[AvFILL(ar)] = Nullsv; + ary = AvARRAY(av); + if (AvREAL(av)) { + if (AvFILL(av) < key) { + while (++AvFILL(av) < key) { + if (ary[AvFILL(av)] != Nullsv) { + sv_free(ary[AvFILL(av)]); + ary[AvFILL(av)] = Nullsv; } } } @@ -110,21 +133,27 @@ SV *val; sv_free(ary[key]); } ary[key] = val; + if (SvMAGICAL(av)) { + MAGIC* mg = SvMAGIC(av); + sv_magic(val, (SV*)av, tolower(mg->mg_type), 0, key); + mg_set((SV*)av); + } return &ary[key]; } AV * newAV() { - register AV *ar; + register AV *av; - Newz(1,ar,1,AV); - SvREFCNT(ar) = 1; - sv_upgrade(ar,SVt_PVAV); - AvREAL_on(ar); - AvALLOC(ar) = AvARRAY(ar) = 0; - AvMAX(ar) = AvFILL(ar) = -1; - return ar; + Newz(1,av,1,AV); + SvREFCNT(av) = 1; + sv_upgrade(av,SVt_PVAV); + AvREAL_on(av); + AvALLOC(av) = 0; + SvPVX(av) = 0; + AvMAX(av) = AvFILL(av) = -1; + return av; } AV * @@ -132,19 +161,19 @@ av_make(size,strp) register I32 size; register SV **strp; { - register AV *ar; + register AV *av; register I32 i; register SV** ary; - Newz(3,ar,1,AV); - sv_upgrade(ar,SVt_PVAV); + Newz(3,av,1,AV); + sv_upgrade(av,SVt_PVAV); New(4,ary,size+1,SV*); - AvALLOC(ar) = ary; + AvALLOC(av) = ary; Zero(ary,size,SV*); - AvREAL_on(ar); - AvARRAY(ar) = ary; - AvFILL(ar) = size - 1; - AvMAX(ar) = size - 1; + AvREAL_on(av); + SvPVX(av) = (char*)ary; + AvFILL(av) = size - 1; + AvMAX(av) = size - 1; for (i = 0; i < size; i++) { if (*strp) { ary[i] = NEWSV(7,0); @@ -152,7 +181,7 @@ register SV **strp; } strp++; } - return ar; + return av; } AV * @@ -160,111 +189,114 @@ av_fake(size,strp) register I32 size; register SV **strp; { - register AV *ar; + register AV *av; register SV** ary; - Newz(3,ar,1,AV); - SvREFCNT(ar) = 1; - sv_upgrade(ar,SVt_PVAV); + Newz(3,av,1,AV); + SvREFCNT(av) = 1; + sv_upgrade(av,SVt_PVAV); New(4,ary,size+1,SV*); - AvALLOC(ar) = ary; + AvALLOC(av) = ary; Copy(strp,ary,size,SV*); - AvREAL_off(ar); - AvARRAY(ar) = ary; - AvFILL(ar) = size - 1; - AvMAX(ar) = size - 1; + AvREAL_off(av); + SvPVX(av) = (char*)ary; + AvFILL(av) = size - 1; + AvMAX(av) = size - 1; while (size--) { if (*strp) SvTEMP_off(*strp); strp++; } - return ar; + return av; } void -av_clear(ar) -register AV *ar; +av_clear(av) +register AV *av; { register I32 key; - if (!ar || !AvREAL(ar) || AvMAX(ar) < 0) + if (!av || !AvREAL(av) || AvMAX(av) < 0) return; /*SUPPRESS 560*/ - if (key = AvARRAY(ar) - AvALLOC(ar)) { - AvMAX(ar) += key; - AvARRAY(ar) -= key; + if (key = AvARRAY(av) - AvALLOC(av)) { + AvMAX(av) += key; + SvPVX(av) = (char*)(AvARRAY(av) - key); } - for (key = 0; key <= AvMAX(ar); key++) - sv_free(AvARRAY(ar)[key]); - AvFILL(ar) = -1; - Zero(AvARRAY(ar), AvMAX(ar)+1, SV*); + for (key = 0; key <= AvMAX(av); key++) + sv_free(AvARRAY(av)[key]); + AvFILL(av) = -1; + Zero(AvARRAY(av), AvMAX(av)+1, SV*); } void -av_undef(ar) -register AV *ar; +av_undef(av) +register AV *av; { register I32 key; - if (!ar) + if (!av) return; /*SUPPRESS 560*/ - if (key = AvARRAY(ar) - AvALLOC(ar)) { - AvMAX(ar) += key; - AvARRAY(ar) -= key; + if (key = AvARRAY(av) - AvALLOC(av)) { + AvMAX(av) += key; + SvPVX(av) = (char*)(AvARRAY(av) - key); } - if (AvREAL(ar)) { - for (key = 0; key <= AvMAX(ar); key++) - sv_free(AvARRAY(ar)[key]); + if (AvREAL(av)) { + for (key = 0; key <= AvMAX(av); key++) + sv_free(AvARRAY(av)[key]); } - Safefree(AvALLOC(ar)); - AvALLOC(ar) = AvARRAY(ar) = 0; - AvMAX(ar) = AvFILL(ar) = -1; + Safefree(AvALLOC(av)); + AvALLOC(av) = 0; + SvPVX(av) = 0; + AvMAX(av) = AvFILL(av) = -1; } void -av_free(ar) -AV *ar; +av_free(av) +AV *av; { - av_undef(ar); - Safefree(ar); + av_undef(av); + Safefree(av); } bool -av_push(ar,val) -register AV *ar; +av_push(av,val) +register AV *av; SV *val; { - return av_store(ar,++(AvFILL(ar)),val) != 0; + return av_store(av,++(AvFILL(av)),val) != 0; } SV * -av_pop(ar) -register AV *ar; +av_pop(av) +register AV *av; { SV *retval; - if (AvFILL(ar) < 0) + if (AvFILL(av) < 0) return Nullsv; - retval = AvARRAY(ar)[AvFILL(ar)]; - AvARRAY(ar)[AvFILL(ar)--] = Nullsv; + retval = AvARRAY(av)[AvFILL(av)]; + AvARRAY(av)[AvFILL(av)--] = Nullsv; + if (SvMAGICAL(av)) + mg_set((SV*)av); return retval; } void -av_popnulls(ar) -register AV *ar; +av_popnulls(av) +register AV *av; { - register I32 fill = AvFILL(ar); + register I32 fill = AvFILL(av); - while (fill >= 0 && !AvARRAY(ar)[fill]) + while (fill >= 0 && !AvARRAY(av)[fill]) fill--; - AvFILL(ar) = fill; + AvFILL(av) = fill; } void -av_unshift(ar,num) -register AV *ar; +av_unshift(av,num) +register AV *av; register I32 num; { register I32 i; @@ -272,62 +304,70 @@ register I32 num; if (num <= 0) return; - if (AvARRAY(ar) - AvALLOC(ar) >= num) { - AvMAX(ar) += num; - AvFILL(ar) += num; - while (num--) - *--AvARRAY(ar) = Nullsv; + if (AvARRAY(av) - AvALLOC(av) >= num) { + AvMAX(av) += num; + AvFILL(av) += num; + while (num--) { + SvPVX(av) = (char*)(AvARRAY(av) - 1); + *AvARRAY(av) = Nullsv; + } } else { - (void)av_store(ar,AvFILL(ar)+num,(SV*)0); /* maybe extend array */ - dstr = AvARRAY(ar) + AvFILL(ar); + (void)av_store(av,AvFILL(av)+num,(SV*)0); /* maybe extend array */ + dstr = AvARRAY(av) + AvFILL(av); sstr = dstr - num; #ifdef BUGGY_MSC5 # pragma loop_opt(off) /* don't loop-optimize the following code */ #endif /* BUGGY_MSC5 */ - for (i = AvFILL(ar) - num; i >= 0; i--) { + for (i = AvFILL(av) - num; i >= 0; i--) { *dstr-- = *sstr--; #ifdef BUGGY_MSC5 # pragma loop_opt() /* loop-optimization back to command-line setting */ #endif /* BUGGY_MSC5 */ } - Zero(AvARRAY(ar), num, SV*); + Zero(AvARRAY(av), num, SV*); } } SV * -av_shift(ar) -register AV *ar; +av_shift(av) +register AV *av; { SV *retval; - if (AvFILL(ar) < 0) + if (AvFILL(av) < 0) return Nullsv; - retval = *AvARRAY(ar); - *(AvARRAY(ar)++) = Nullsv; - AvMAX(ar)--; - AvFILL(ar)--; + retval = *AvARRAY(av); + *AvARRAY(av) = Nullsv; + SvPVX(av) = (char*)(AvARRAY(av) + 1); + AvMAX(av)--; + AvFILL(av)--; + if (SvMAGICAL(av)) + mg_set((SV*)av); return retval; } I32 -av_len(ar) -register AV *ar; +av_len(av) +register AV *av; { - return AvFILL(ar); + return AvFILL(av); } void -av_fill(ar, fill) -register AV *ar; +av_fill(av, fill) +register AV *av; I32 fill; { if (fill < 0) fill = -1; - if (fill <= AvMAX(ar)) - AvFILL(ar) = fill; + if (fill <= AvMAX(av)) { + AvFILL(av) = fill; + if (SvMAGICAL(av)) + mg_set((SV*)av); + } else { - AvFILL(ar) = fill - 1; /* don't clobber in-between values */ - (void)av_store(ar,fill,Nullsv); + AvFILL(av) = fill - 1; /* don't clobber in-between values */ + (void)av_store(av,fill,Nullsv); } } @@ -21,21 +21,16 @@ */ struct xpvav { - char * xpv_pv; /* pointer to malloced string */ - STRLEN xpv_cur; /* length of xp_pv as a C string */ - STRLEN xpv_len; /* allocated size */ - STRLEN xof_off; /* ptr is incremented by offset */ + char * xav_array; /* pointer to malloced string */ + int xav_fill; + int xav_max; + int xof_off; /* ptr is incremented by offset */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ - MAGIC* xav_magic; /* magic for elements */ - - SV** xav_array; SV** xav_alloc; SV* xav_arylen; - I32 xav_max; - I32 xav_fill; U8 xav_flags; }; @@ -43,8 +38,7 @@ struct xpvav { #define Nullav Null(AV*) -#define AvMAGIC(av) ((XPVAV*) SvANY(av))->xav_magic -#define AvARRAY(av) ((XPVAV*) SvANY(av))->xav_array +#define AvARRAY(av) ((SV**)((XPVAV*) SvANY(av))->xav_array) #define AvALLOC(av) ((XPVAV*) SvANY(av))->xav_alloc #define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max #define AvFILL(av) ((XPVAV*) SvANY(av))->xav_fill @@ -1,5 +1,7 @@ #!./perl -sub foo; - -foo; +$o = {A,1}; +$r = \($o->{A}); +print $$r; +$$r = foo; +print $$r; @@ -233,8 +233,8 @@ medium='' large='' huge='' optimize='-g' -ccflags='-DDEBUGGING' -cppflags='-DDEBUGGING' +ccflags='-DDEBUGGING -DHAS_SDBM' +cppflags='-DDEBUGGING -DHAS_SDBM' ldflags='' cc='cc' nativegcc='' @@ -68,7 +68,7 @@ struct cop { struct block_sub { CV * cv; GV * gv; - GV * defgv; + GV * dfoutgv; AV * savearray; AV * argarray; AV * comppad; @@ -85,7 +85,7 @@ struct block_sub { #define PUSHFORMAT(cx) \ cx->blk_sub.cv = cv; \ cx->blk_sub.gv = gv; \ - cx->blk_sub.defgv = defoutgv; \ + cx->blk_sub.dfoutgv = defoutgv; \ cx->blk_sub.hasargs = 0; #define POPSUB(cx) \ @@ -95,11 +95,11 @@ struct block_sub { } \ if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) { \ if (CvDELETED(cx->blk_sub.cv)) \ - cv_free(cx->blk_sub.cv); \ + sv_free((SV*)cx->blk_sub.cv); \ } #define POPFORMAT(cx) \ - defoutgv = cx->blk_sub.defgv; + defoutgv = cx->blk_sub.dfoutgv; /* eval context */ struct block_eval { @@ -57,8 +57,12 @@ char *pat; } # else /*VARARGS1*/ +#ifdef __STDC__ +void deb(char *pat,...) +#else void deb(va_alist) va_dcl +#endif { va_list args; char *pat; diff --git a/do/accept b/do/accept deleted file mode 100644 index dd0c203aeb..0000000000 --- a/do/accept +++ /dev/null @@ -1,51 +0,0 @@ -void -do_accept(TARG, nstab, gstab) -STR *TARG; -STAB *nstab; -STAB *gstab; -{ - register STIO *nstio; - register STIO *gstio; - int len = sizeof buf; - int fd; - - if (!nstab) - goto badexit; - if (!gstab) - goto nuts; - - gstio = stab_io(gstab); - nstio = stab_io(nstab); - - if (!gstio || !gstio->ifp) - goto nuts; - if (!nstio) - nstio = stab_io(nstab) = stio_new(); - else if (nstio->ifp) - do_close(nstab,FALSE); - - fd = accept(fileno(gstio->ifp),(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); - goto badexit; - } - - str_nset(TARG, buf, len); - return; - -nuts: - if (dowarn) - warn("accept() on closed fd"); - errno = EBADF; -badexit: - str_sset(TARG,&str_undef); - return; -} - diff --git a/do/aexec b/do/aexec deleted file mode 100644 index d8f0dcfc6f..0000000000 --- a/do/aexec +++ /dev/null @@ -1,34 +0,0 @@ -bool -do_aexec(really,arglast) -STR *really; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int items = arglast[2] - sp; - register char **a; - char *tmps; - - if (items) { - New(401,Argv, items+1, char*); - a = Argv; - for (st += ++sp; items > 0; items--,st++) { - if (*st) - *a++ = str_get(*st); - else - *a++ = ""; - } - *a = Nullch; -#ifdef TAINT - if (*Argv[0] != '/') /* will execvp use PATH? */ - taintenv(); /* testing IFS here is overkill, probably */ -#endif - if (really && *(tmps = str_get(really))) - execvp(tmps,Argv); - else - execvp(Argv[0],Argv); - } - do_execfree(); - return FALSE; -} - diff --git a/do/aprint b/do/aprint deleted file mode 100644 index bda86c8b2c..0000000000 --- a/do/aprint +++ /dev/null @@ -1,41 +0,0 @@ -bool -do_aprint(arg,fp,arglast) -register ARG *arg; -register FILE *fp; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int retval; - register int items = arglast[2] - sp; - - if (!fp) { - if (dowarn) - warn("print to unopened file"); - errno = EBADF; - return FALSE; - } - st += ++sp; - if (arg->arg_type == O_PRTF) { - do_sprintf(ARGTARG,items,st); - retval = do_print(ARGTARG,fp); - } - else { - retval = (items <= 0); - for (; items > 0; items--,st++) { - if (retval && ofslen) { - if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) { - retval = FALSE; - break; - } - } - if (!(retval = do_print(*st, fp))) - break; - } - if (retval && orslen) - if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp)) - retval = FALSE; - } - return retval; -} - diff --git a/do/assign b/do/assign deleted file mode 100644 index 2799d024b0..0000000000 --- a/do/assign +++ /dev/null @@ -1,201 +0,0 @@ -int -do_assign(arg,gimme,arglast) -register ARG *arg; -int gimme; -int *arglast; -{ - - register STR **st = stack->ary_array; - STR **firstrelem = st + arglast[1] + 1; - STR **firstlelem = st + arglast[0] + 1; - STR **lastrelem = st + arglast[2]; - STR **lastlelem = st + arglast[1]; - register STR **relem; - register STR **lelem; - - register STR *TARG; - register ARRAY *ary; - register int makelocal; - HASH *hash; - int i; - - makelocal = (arg->arg_flags & AF_LOCAL) != 0; - localizing = makelocal; - delaymagic = DM_DELAY; /* catch simultaneous items */ - - /* If there's a common identifier on both sides we have to take - * special care that assigning the identifier on the left doesn't - * clobber a value on the right that's used later in the list. - */ - if (arg->arg_flags & AF_COMMON) { - for (relem = firstrelem; relem <= lastrelem; relem++) { - /*SUPPRESS 560*/ - if (TARG = *relem) - *relem = str_mortal(TARG); - } - } - relem = firstrelem; - lelem = firstlelem; - ary = Null(ARRAY*); - hash = Null(HASH*); - while (lelem <= lastlelem) { - TARG = *lelem++; - if (TARG->str_state >= SS_HASH) { - if (TARG->str_state == SS_ARY) { - if (makelocal) - ary = saveary(TARG->str_u.str_stab); - else { - ary = stab_array(TARG->str_u.str_stab); - ary->ary_fill = -1; - } - i = 0; - while (relem <= lastrelem) { /* gobble up all the rest */ - TARG = Str_new(28,0); - if (*relem) - str_sset(TARG,*relem); - *(relem++) = TARG; - (void)astore(ary,i++,TARG); - } - } - else if (TARG->str_state == SS_HASH) { - char *tmps; - STR *tmpstr; - int magic = 0; - STAB *tmpstab = TARG->str_u.str_stab; - - if (makelocal) - hash = savehash(TARG->str_u.str_stab); - else { - hash = stab_hash(TARG->str_u.str_stab); - if (tmpstab == envstab) { - magic = 'E'; - environ[0] = Nullch; - } - else if (tmpstab == sigstab) { - magic = 'S'; -#ifndef NSIG -#define NSIG 32 -#endif - for (i = 1; i < NSIG; i++) - signal(i, SIG_DFL); /* crunch, crunch, crunch */ - } -#ifdef SOME_DBM - else if (hash->tbl_dbm) - magic = 'D'; -#endif - hclear(hash, magic == 'D'); /* wipe any dbm file too */ - - } - while (relem < lastrelem) { /* gobble up all the rest */ - if (*relem) - TARG = *(relem++); - else - TARG = &str_no, relem++; - tmps = str_get(TARG); - tmpstr = Str_new(29,0); - if (*relem) - str_sset(tmpstr,*relem); /* value */ - *(relem++) = tmpstr; - (void)hstore(hash,tmps,TARG->str_cur,tmpstr,0); - if (magic) { - str_magic(tmpstr, tmpstab, magic, tmps, TARG->str_cur); - stabset(tmpstr->str_magic, tmpstr); - } - } - } - else - fatal("panic: do_assign"); - } - else { - if (makelocal) - saveitem(TARG); - if (relem <= lastrelem) { - str_sset(TARG, *relem); - *(relem++) = TARG; - } - else { - str_sset(TARG, &str_undef); - if (gimme == G_ARRAY) { - i = ++lastrelem - firstrelem; - relem++; /* tacky, I suppose */ - astore(stack,i,TARG); - if (st != stack->ary_array) { - st = stack->ary_array; - firstrelem = st + arglast[1] + 1; - firstlelem = st + arglast[0] + 1; - lastlelem = st + arglast[1]; - lastrelem = st + i; - relem = lastrelem + 1; - } - } - } - STABSET(TARG); - } - } - if (delaymagic & ~DM_DELAY) { - if (delaymagic & DM_UID) { -#ifdef HAS_SETREUID - (void)setreuid(uid,euid); -#else /* not HAS_SETREUID */ -#ifdef HAS_SETRUID - if ((delaymagic & DM_UID) == DM_RUID) { - (void)setruid(uid); - delaymagic =~ DM_RUID; - } -#endif /* HAS_SETRUID */ -#ifdef HAS_SETEUID - if ((delaymagic & DM_UID) == DM_EUID) { - (void)seteuid(uid); - delaymagic =~ DM_EUID; - } -#endif /* HAS_SETEUID */ - if (delaymagic & DM_UID) { - if (uid != euid) - fatal("No setreuid available"); - (void)setuid(uid); - } -#endif /* not HAS_SETREUID */ - uid = (int)getuid(); - euid = (int)geteuid(); - } - if (delaymagic & DM_GID) { -#ifdef HAS_SETREGID - (void)setregid(gid,egid); -#else /* not HAS_SETREGID */ -#ifdef HAS_SETRGID - if ((delaymagic & DM_GID) == DM_RGID) { - (void)setrgid(gid); - delaymagic =~ DM_RGID; - } -#endif /* HAS_SETRGID */ -#ifdef HAS_SETEGID - if ((delaymagic & DM_GID) == DM_EGID) { - (void)setegid(gid); - delaymagic =~ DM_EGID; - } -#endif /* HAS_SETEGID */ - if (delaymagic & DM_GID) { - if (gid != egid) - fatal("No setregid available"); - (void)setgid(gid); - } -#endif /* not HAS_SETREGID */ - gid = (int)getgid(); - egid = (int)getegid(); - } - } - delaymagic = 0; - localizing = FALSE; - if (gimme == G_ARRAY) { - i = lastrelem - firstrelem + 1; - if (ary || hash) - Copy(firstrelem, firstlelem, i, STR*); - return arglast[0] + i; - } - else { - str_numset(ARGTARG,(double)(arglast[2] - arglast[1])); - *firstlelem = ARGTARG; - return arglast[0] + 1; - } -} - diff --git a/do/bind b/do/bind deleted file mode 100644 index d5f669026f..0000000000 --- a/do/bind +++ /dev/null @@ -1,31 +0,0 @@ -int -do_bind(stab, arglast) -STAB *stab; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register STIO *stio; - char *addr; - - if (!stab) - goto nuts; - - stio = stab_io(stab); - if (!stio || !stio->ifp) - goto nuts; - - addr = str_get(st[++sp]); -#ifdef TAINT - taintproper("Insecure dependency in bind"); -#endif - return bind(fileno(stio->ifp), addr, st[sp]->str_cur) >= 0; - -nuts: - if (dowarn) - warn("bind() on closed fd"); - errno = EBADF; - return FALSE; - -} - diff --git a/do/caller b/do/caller deleted file mode 100644 index cb921e507d..0000000000 --- a/do/caller +++ /dev/null @@ -1,67 +0,0 @@ -int -do_caller(arg,maxarg,gimme,arglast) -ARG *arg; -int maxarg; -int gimme; -int *arglast; -{ - STR **st = stack->ary_array; - register int sp = arglast[0]; - register CSV *csv = curcsv; - STR *TARG; - int count = 0; - - if (!csv) - fatal("There is no caller"); - if (maxarg) - count = (int) str_gnum(st[sp+1]); - for (;;) { - if (!csv) - return sp; - if (DBsub && csv->oldcsv && csv->oldcsv->sub == stab_sub(DBsub)) - count++; - if (!count--) - break; - csv = csv->oldcsv; - } - if (gimme != G_ARRAY) { - STR *TARG = ARGTARG; - str_set(TARG,csv->oldcmd->c_stash->tbl_name); - STABSET(TARG); - st[++sp] = TARG; - return sp; - } - -#ifndef lint - (void)astore(stack,++sp, - str_2mortal(str_make(csv->oldcmd->c_stash->tbl_name,0)) ); - (void)astore(stack,++sp, - str_2mortal(str_make(stab_val(csv->oldcmd->c_filestab)->str_ptr,0)) ); - (void)astore(stack,++sp, - str_2mortal(str_nmake((double)csv->oldcmd->c_line)) ); - if (!maxarg) - return sp; - TARG = Str_new(49,0); - stab_efullname(TARG, csv->stab); - (void)astore(stack,++sp, str_2mortal(TARG)); - (void)astore(stack,++sp, - str_2mortal(str_nmake((double)csv->hasargs)) ); - (void)astore(stack,++sp, - str_2mortal(str_nmake((double)csv->wantarray)) ); - if (csv->hasargs) { - ARRAY *ary = csv->argarray; - - if (!dbargs) - dbargs = stab_xarray(aadd(stabent("DB'args", TRUE))); - if (dbargs->ary_max < ary->ary_fill) - astore(dbargs,ary->ary_fill,Nullstr); - Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*); - dbargs->ary_fill = ary->ary_fill; - } -#else - (void)astore(stack,++sp, - str_2mortal(str_make("",0))); -#endif - return sp; -} - diff --git a/do/chop b/do/chop deleted file mode 100644 index 377d694bef..0000000000 --- a/do/chop +++ /dev/null @@ -1,40 +0,0 @@ -void -do_chop(astr,TARG) -register STR *astr; -register STR *TARG; -{ - register char *tmps; - register int i; - ARRAY *ary; - HASH *hash; - HENT *entry; - - if (!TARG) - return; - if (TARG->str_state == SS_ARY) { - ary = stab_array(TARG->str_u.str_stab); - for (i = 0; i <= ary->ary_fill; i++) - do_chop(astr,ary->ary_array[i]); - return; - } - if (TARG->str_state == SS_HASH) { - hash = stab_hash(TARG->str_u.str_stab); - (void)hiterinit(hash); - /*SUPPRESS 560*/ - while (entry = hiternext(hash)) - do_chop(astr,hiterval(hash,entry)); - return; - } - tmps = str_get(TARG); - if (tmps && TARG->str_cur) { - tmps += TARG->str_cur - 1; - str_nset(astr,tmps,1); /* remember last char */ - *tmps = '\0'; /* wipe it out */ - TARG->str_cur = tmps - TARG->str_ptr; - TARG->str_nok = 0; - STABSET(TARG); - } - else - str_nset(astr,"",0); -} - diff --git a/do/close b/do/close deleted file mode 100644 index 2ddc1428b9..0000000000 --- a/do/close +++ /dev/null @@ -1,45 +0,0 @@ -bool -do_close(stab,explicit) -STAB *stab; -bool explicit; -{ - bool retval = FALSE; - register STIO *stio; - int status; - - if (!stab) - stab = argvstab; - if (!stab) { - errno = EBADF; - return FALSE; - } - stio = stab_io(stab); - if (!stio) { /* never opened */ - if (dowarn && explicit) - warn("Close on unopened file <%s>",stab_ename(stab)); - return FALSE; - } - if (stio->ifp) { - if (stio->type == '|') { - status = mypclose(stio->ifp); - retval = (status == 0); - statusvalue = (unsigned short)status & 0xffff; - } - else if (stio->type == '-') - retval = TRUE; - else { - if (stio->ofp && stio->ofp != stio->ifp) { /* a socket */ - retval = (fclose(stio->ofp) != EOF); - fclose(stio->ifp); /* clear stdio, fd already closed */ - } - else - retval = (fclose(stio->ifp) != EOF); - } - stio->ofp = stio->ifp = Nullfp; - } - if (explicit) - stio->lines = 0; - stio->type = ' '; - return retval; -} - diff --git a/do/connect b/do/connect deleted file mode 100644 index 08230d2411..0000000000 --- a/do/connect +++ /dev/null @@ -1,29 +0,0 @@ -int -do_connect(stab, arglast) -STAB *stab; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register STIO *stio; - char *addr; - - if (!stab) - goto nuts; - - stio = stab_io(stab); - if (!stio || !stio->ifp) - goto nuts; - - addr = str_get(st[++sp]); - TAINT_PROPER("connect"); - return connect(fileno(stio->ifp), addr, st[sp]->str_cur) >= 0; - -nuts: - if (dowarn) - warn("connect() on closed fd"); - errno = EBADF; - return FALSE; - -} - diff --git a/do/ctl b/do/ctl deleted file mode 100644 index 543cea83a2..0000000000 --- a/do/ctl +++ /dev/null @@ -1,72 +0,0 @@ -int -do_ctl(optype,stab,func,argstr) -int optype; -STAB *stab; -int func; -STR *argstr; -{ - register STIO *stio; - register char *s; - int retval; - - if (!stab || !argstr || !(stio = stab_io(stab)) || !stio->ifp) { - errno = EBADF; /* well, sort of... */ - return -1; - } - - if (argstr->str_pok || !argstr->str_nok) { - if (!argstr->str_pok) - s = str_get(argstr); - -#ifdef IOCPARM_MASK -#ifndef IOCPARM_LEN -#define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) -#endif -#endif -#ifdef IOCPARM_LEN - retval = IOCPARM_LEN(func); /* on BSDish systes we're safe */ -#else - retval = 256; /* otherwise guess at what's safe */ -#endif - if (argstr->str_cur < retval) { - Str_Grow(argstr,retval+1); - argstr->str_cur = retval; - } - - s = argstr->str_ptr; - s[argstr->str_cur] = 17; /* a little sanity check here */ - } - else { - retval = (int)str_gnum(argstr); -#ifdef DOSISH - s = (char*)(long)retval; /* ouch */ -#else - s = (char*)retval; /* ouch */ -#endif - } - -#ifndef lint - if (optype == O_IOCTL) - retval = ioctl(fileno(stio->ifp), func, s); - else -#ifdef DOSISH - fatal("fcntl is not implemented"); -#else -#ifdef HAS_FCNTL - retval = fcntl(fileno(stio->ifp), func, s); -#else - fatal("fcntl is not implemented"); -#endif -#endif -#else /* lint */ - retval = 0; -#endif /* lint */ - - if (argstr->str_pok) { - if (s[argstr->str_cur] != 17) - fatal("Return value overflowed string"); - s[argstr->str_cur] = 0; /* put our null back */ - } - return retval; -} - diff --git a/do/defined b/do/defined deleted file mode 100644 index 2721f05032..0000000000 --- a/do/defined +++ /dev/null @@ -1,42 +0,0 @@ -int /*SUPPRESS 590*/ -do_defined(TARG,arg,gimme,arglast) -STR *TARG; -register ARG *arg; -int gimme; -int *arglast; -{ - register int type; - register int retarg = arglast[0] + 1; - int retval; - ARRAY *ary; - HASH *hash; - - if ((arg[1].arg_type & A_MASK) != A_LEXPR) - fatal("Illegal argument to defined()"); - arg = arg[1].arg_ptr.arg_arg; - type = arg->arg_type; - - if (type == O_SUBR || type == O_DBSUBR) { - if ((arg[1].arg_type & A_MASK) == A_WORD) - retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0; - else { - STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab); - - retval = tmpstr && stab_sub(stabent(str_get(tmpstr),TRUE)) != 0; - } - } - else if (type == O_ARRAY || type == O_LARRAY || - type == O_ASLICE || type == O_LASLICE ) - retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0 - && ary->ary_max >= 0 ); - else if (type == O_HASH || type == O_LHASH || - type == O_HSLICE || type == O_LHSLICE ) - retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0 - && hash->tbl_array); - else - retval = FALSE; - str_numset(TARG,(double)retval); - stack->ary_array[retarg] = TARG; - return retarg; -} - diff --git a/do/dirop b/do/dirop deleted file mode 100644 index 6f4c0b6a12..0000000000 --- a/do/dirop +++ /dev/null @@ -1,101 +0,0 @@ -int -do_dirop(optype,stab,gimme,arglast) -int optype; -STAB *stab; -int gimme; -int *arglast; -{ -#if defined(DIRENT) && defined(HAS_READDIR) - register ARRAY *ary = stack; - register STR **st = ary->ary_array; - register int sp = arglast[1]; - register STIO *stio; - long along; -#ifndef apollo - struct DIRENT *readdir(); -#endif - register struct DIRENT *dp; - - if (!stab) - goto nope; - if (!(stio = stab_io(stab))) - stio = stab_io(stab) = stio_new(); - if (!stio->dirp && optype != O_OPEN_DIR) - goto nope; - st[sp] = &str_yes; - switch (optype) { - case O_OPEN_DIR: - if (stio->dirp) - closedir(stio->dirp); - if (!(stio->dirp = opendir(str_get(st[sp+1])))) - goto nope; - break; - case O_READDIR: - if (gimme == G_ARRAY) { - --sp; - /*SUPPRESS 560*/ - while (dp = readdir(stio->dirp)) { -#ifdef DIRNAMLEN - (void)astore(ary,++sp, - str_2mortal(str_make(dp->d_name,dp->d_namlen))); -#else - (void)astore(ary,++sp, - str_2mortal(str_make(dp->d_name,0))); -#endif - } - } - else { - if (!(dp = readdir(stio->dirp))) - goto nope; - st[sp] = str_mortal(&str_undef); -#ifdef DIRNAMLEN - str_nset(st[sp], dp->d_name, dp->d_namlen); -#else - str_set(st[sp], dp->d_name); -#endif - } - break; -#if defined(HAS_TELLDIR) || defined(telldir) - case O_TELLDIR: { -#ifndef telldir - long telldir(); -#endif - st[sp] = str_mortal(&str_undef); - str_numset(st[sp], (double)telldir(stio->dirp)); - break; - } -#endif -#if defined(HAS_SEEKDIR) || defined(seekdir) - case O_SEEKDIR: - st[sp] = str_mortal(&str_undef); - along = (long)str_gnum(st[sp+1]); - (void)seekdir(stio->dirp,along); - break; -#endif -#if defined(HAS_REWINDDIR) || defined(rewinddir) - case O_REWINDDIR: - st[sp] = str_mortal(&str_undef); - (void)rewinddir(stio->dirp); - break; -#endif - case O_CLOSEDIR: - st[sp] = str_mortal(&str_undef); - (void)closedir(stio->dirp); - stio->dirp = 0; - break; - default: - goto phooey; - } - return sp; - -nope: - st[sp] = &str_undef; - if (!errno) - errno = EBADF; - return sp; - -#endif -phooey: - fatal("Unimplemented directory operation"); -} - diff --git a/do/each b/do/each deleted file mode 100644 index 735012659e..0000000000 --- a/do/each +++ /dev/null @@ -1,33 +0,0 @@ -int -do_each(TARG,hash,gimme,arglast) -STR *TARG; -HASH *hash; -int gimme; -int *arglast; -{ - STR **st = stack->ary_array; - register int sp = arglast[0]; - HENT *entry = hiternext(hash); - int i; - char *tmps; - - if (mystrk) { - str_free(mystrk); - mystrk = Nullstr; - } - - if (entry) { - if (gimme == G_ARRAY) { - tmps = hiterkey(entry, &i); - if (!i) - tmps = ""; - st[++sp] = mystrk = str_make(tmps,i); - } - st[++sp] = TARG; - str_sset(TARG,hiterval(hash,entry)); - STABSET(TARG); - return sp; - } - else - return sp; -} diff --git a/do/eof b/do/eof deleted file mode 100644 index a1512cd2b0..0000000000 --- a/do/eof +++ /dev/null @@ -1,45 +0,0 @@ -bool -do_eof(stab) -STAB *stab; -{ - register STIO *stio; - int ch; - - if (!stab) { /* eof() */ - if (argvstab) - stio = stab_io(argvstab); - else - return TRUE; - } - else - stio = stab_io(stab); - - if (!stio) - return TRUE; - - while (stio->ifp) { - -#ifdef STDSTDIO /* (the code works without this) */ - if (stio->ifp->_cnt > 0) /* cheat a little, since */ - return FALSE; /* this is the most usual case */ -#endif - - ch = getc(stio->ifp); - if (ch != EOF) { - (void)ungetc(ch, stio->ifp); - return FALSE; - } -#ifdef STDSTDIO - if (stio->ifp->_cnt < -1) - stio->ifp->_cnt = -1; -#endif - if (!stab) { /* not necessarily a real EOF yet? */ - if (!nextargv(argvstab)) /* get another fp handy */ - return TRUE; - } - else - return TRUE; /* normal fp, definitely end of file */ - } - return TRUE; -} - diff --git a/do/exec b/do/exec deleted file mode 100644 index 5aee9a2f93..0000000000 --- a/do/exec +++ /dev/null @@ -1,77 +0,0 @@ -bool -do_exec(cmd) -char *cmd; -{ - register char **a; - register char *s; - char flags[10]; - - /* save an extra exec if possible */ - -#ifdef CSH - if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) { - strcpy(flags,"-c"); - s = cmd+cshlen+3; - if (*s == 'f') { - s++; - strcat(flags,"f"); - } - if (*s == ' ') - s++; - if (*s++ == '\'') { - char *ncmd = s; - - while (*s) - s++; - if (s[-1] == '\n') - *--s = '\0'; - if (s[-1] == '\'') { - *--s = '\0'; - execl(cshname,"csh", flags,ncmd,(char*)0); - *s = '\''; - return FALSE; - } - } - } -#endif /* CSH */ - - /* see if there are shell metacharacters in it */ - - /*SUPPRESS 530*/ - for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */ - if (*s == '=') - goto doshell; - for (s = cmd; *s; s++) { - if (*s != ' ' && !isALPHA(*s) && index("$&*(){}[]'\";\\|?<>~`\n",*s)) { - if (*s == '\n' && !s[1]) { - *s = '\0'; - break; - } - doshell: - execl("/bin/sh","sh","-c",cmd,(char*)0); - return FALSE; - } - } - New(402,Argv, (s - cmd) / 2 + 2, char*); - Cmd = nsavestr(cmd, s-cmd); - a = Argv; - for (s = Cmd; *s;) { - while (*s && isSPACE(*s)) s++; - if (*s) - *(a++) = s; - while (*s && !isSPACE(*s)) s++; - if (*s) - *s++ = '\0'; - } - *a = Nullch; - if (Argv[0]) { - execvp(Argv[0],Argv); - if (errno == ENOEXEC) { /* for system V NIH syndrome */ - do_execfree(); - goto doshell; - } - } - do_execfree(); - return FALSE; -} - diff --git a/do/execfree b/do/execfree deleted file mode 100644 index 3f5bd394e1..0000000000 --- a/do/execfree +++ /dev/null @@ -1,13 +0,0 @@ -void -do_execfree() -{ - if (Argv) { - Safefree(Argv); - Argv = Null(char **); - } - if (Cmd) { - Safefree(Cmd); - Cmd = Nullch; - } -} - diff --git a/do/fttext b/do/fttext deleted file mode 100644 index 6d6f28834f..0000000000 --- a/do/fttext +++ /dev/null @@ -1,94 +0,0 @@ -STR * -do_fttext(arg,TARG) -register ARG *arg; -STR *TARG; -{ - int i; - int len; - int odd = 0; - STDCHAR tbuf[512]; - register STDCHAR *s; - register STIO *stio; - - if (arg[1].arg_type & A_DONT) { - if (arg[1].arg_ptr.arg_stab == defstab) { - if (statstab) - stio = stab_io(statstab); - else { - TARG = statname; - goto really_filename; - } - } - else { - statstab = arg[1].arg_ptr.arg_stab; - str_set(statname,""); - stio = stab_io(statstab); - } - if (stio && stio->ifp) { -#if defined(STDSTDIO) || defined(atarist) /* this will work with atariST */ - fstat(fileno(stio->ifp),&statcache); - if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */ - return arg->arg_type == O_FTTEXT ? &str_no : &str_yes; - if (stio->ifp->_cnt <= 0) { - i = getc(stio->ifp); - if (i != EOF) - (void)ungetc(i,stio->ifp); - } - if (stio->ifp->_cnt <= 0) /* null file is anything */ - return &str_yes; - len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base); - s = stio->ifp->_base; -#else - fatal("-T and -B not implemented on filehandles"); -#endif - } - else { - if (dowarn) - warn("Test on unopened file <%s>", - stab_ename(arg[1].arg_ptr.arg_stab)); - errno = EBADF; - return &str_undef; - } - } - else { - statstab = Nullstab; - str_set(statname,str_get(TARG)); - really_filename: - i = open(str_get(TARG),0); - if (i < 0) { - if (dowarn && index(str_get(TARG), '\n')) - warn(warn_nl, "open"); - return &str_undef; - } - fstat(i,&statcache); - len = read(i,tbuf,512); - (void)close(i); - if (len <= 0) { - if (S_ISDIR(statcache.st_mode) && arg->arg_type == O_FTTEXT) - return &str_no; /* special case NFS directories */ - return &str_yes; /* null file is anything */ - } - s = tbuf; - } - - /* now scan s to look for textiness */ - - for (i = 0; i < len; i++,s++) { - if (!*s) { /* null never allowed in text */ - odd += len; - break; - } - else if (*s & 128) - odd++; - else if (*s < 32 && - *s != '\n' && *s != '\r' && *s != '\b' && - *s != '\t' && *s != '\f' && *s != 27) - odd++; - } - - if ((odd * 10 > len) == (arg->arg_type == O_FTTEXT)) /* allow 10% odd */ - return &str_no; - else - return &str_yes; -} - diff --git a/do/getsockname b/do/getsockname deleted file mode 100644 index b899400321..0000000000 --- a/do/getsockname +++ /dev/null @@ -1,45 +0,0 @@ -int -do_getsockname(optype, stab, arglast) -int optype; -STAB *stab; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register STIO *stio; - int fd; - - if (!stab) - goto nuts; - - stio = stab_io(stab); - if (!stio || !stio->ifp) - goto nuts; - - st[sp] = str_2mortal(Str_new(22,257)); - st[sp]->str_cur = 256; - st[sp]->str_pok = 1; - fd = fileno(stio->ifp); - switch (optype) { - case O_GETSOCKNAME: - if (getsockname(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0) - goto nuts2; - break; - case O_GETPEERNAME: - if (getpeername(fd, st[sp]->str_ptr, (int*)&st[sp]->str_cur) < 0) - goto nuts2; - break; - } - - return sp; - -nuts: - if (dowarn) - warn("get{sock,peer}name() on closed fd"); - errno = EBADF; -nuts2: - st[sp] = &str_undef; - return sp; - -} - diff --git a/do/ggrent b/do/ggrent deleted file mode 100644 index bf4a918e47..0000000000 --- a/do/ggrent +++ /dev/null @@ -1,61 +0,0 @@ -int -do_ggrent(which,gimme,arglast) -int which; -int gimme; -int *arglast; -{ -#ifdef I_GRP - register ARRAY *ary = stack; - register int sp = arglast[0]; - register char **elem; - register STR *TARG; - struct group *getgrnam(); - struct group *getgrgid(); - struct group *getgrent(); - struct group *grent; - - if (which == O_GGRNAM) { - char *name = str_get(ary->ary_array[sp+1]); - - grent = getgrnam(name); - } - else if (which == O_GGRGID) { - int gid = (int)str_gnum(ary->ary_array[sp+1]); - - grent = getgrgid(gid); - } - else - grent = getgrent(); - - if (gimme != G_ARRAY) { - astore(ary, ++sp, TARG = str_mortal(&str_undef)); - if (grent) { - if (which == O_GGRNAM) - str_numset(TARG, (double)grent->gr_gid); - else - str_set(TARG, grent->gr_name); - } - return sp; - } - - if (grent) { - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, grent->gr_name); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, grent->gr_passwd); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_numset(TARG, (double)grent->gr_gid); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - for (elem = grent->gr_mem; *elem; elem++) { - str_cat(TARG, *elem); - if (elem[1]) - str_ncat(TARG," ",1); - } - } - - return sp; -#else - fatal("group routines not implemented"); -#endif -} - diff --git a/do/ghent b/do/ghent deleted file mode 100644 index db4a570c73..0000000000 --- a/do/ghent +++ /dev/null @@ -1,92 +0,0 @@ -int -do_ghent(which,gimme,arglast) -int which; -int gimme; -int *arglast; -{ - register ARRAY *ary = stack; - register int sp = arglast[0]; - register char **elem; - register STR *TARG; - struct hostent *gethostbyname(); - struct hostent *gethostbyaddr(); -#ifdef HAS_GETHOSTENT - struct hostent *gethostent(); -#endif - struct hostent *hent; - unsigned long len; - - if (which == O_GHBYNAME) { - char *name = str_get(ary->ary_array[sp+1]); - - hent = gethostbyname(name); - } - else if (which == O_GHBYADDR) { - STR *addrstr = ary->ary_array[sp+1]; - int addrtype = (int)str_gnum(ary->ary_array[sp+2]); - char *addr = str_get(addrstr); - - hent = gethostbyaddr(addr,addrstr->str_cur,addrtype); - } - else -#ifdef HAS_GETHOSTENT - hent = gethostent(); -#else - fatal("gethostent not implemented"); -#endif - -#ifdef HOST_NOT_FOUND - if (!hent) - statusvalue = (unsigned short)h_errno & 0xffff; -#endif - - if (gimme != G_ARRAY) { - astore(ary, ++sp, TARG = str_mortal(&str_undef)); - if (hent) { - if (which == O_GHBYNAME) { -#ifdef h_addr - str_nset(TARG, *hent->h_addr, hent->h_length); -#else - str_nset(TARG, hent->h_addr, hent->h_length); -#endif - } - else - str_set(TARG, hent->h_name); - } - return sp; - } - - if (hent) { -#ifndef lint - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, hent->h_name); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - for (elem = hent->h_aliases; *elem; elem++) { - str_cat(TARG, *elem); - if (elem[1]) - str_ncat(TARG," ",1); - } - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_numset(TARG, (double)hent->h_addrtype); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - len = hent->h_length; - str_numset(TARG, (double)len); -#ifdef h_addr - for (elem = hent->h_addr_list; *elem; elem++) { - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_nset(TARG, *elem, len); - } -#else - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_nset(TARG, hent->h_addr, len); -#endif /* h_addr */ -#else /* lint */ - elem = Nullch; - elem = elem; - (void)astore(ary, ++sp, str_mortal(&str_no)); -#endif /* lint */ - } - - return sp; -} - diff --git a/do/gnent b/do/gnent deleted file mode 100644 index 131e6fee26..0000000000 --- a/do/gnent +++ /dev/null @@ -1,64 +0,0 @@ -int -do_gnent(which,gimme,arglast) -int which; -int gimme; -int *arglast; -{ - register ARRAY *ary = stack; - register int sp = arglast[0]; - register char **elem; - register STR *TARG; - struct netent *getnetbyname(); - struct netent *getnetbyaddr(); - struct netent *getnetent(); - struct netent *nent; - - if (which == O_GNBYNAME) { - char *name = str_get(ary->ary_array[sp+1]); - - nent = getnetbyname(name); - } - else if (which == O_GNBYADDR) { - unsigned long addr = U_L(str_gnum(ary->ary_array[sp+1])); - int addrtype = (int)str_gnum(ary->ary_array[sp+2]); - - nent = getnetbyaddr((long)addr,addrtype); - } - else - nent = getnetent(); - - if (gimme != G_ARRAY) { - astore(ary, ++sp, TARG = str_mortal(&str_undef)); - if (nent) { - if (which == O_GNBYNAME) - str_numset(TARG, (double)nent->n_net); - else - str_set(TARG, nent->n_name); - } - return sp; - } - - if (nent) { -#ifndef lint - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, nent->n_name); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - for (elem = nent->n_aliases; *elem; elem++) { - str_cat(TARG, *elem); - if (elem[1]) - str_ncat(TARG," ",1); - } - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_numset(TARG, (double)nent->n_addrtype); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_numset(TARG, (double)nent->n_net); -#else /* lint */ - elem = Nullch; - elem = elem; - (void)astore(ary, ++sp, str_mortal(&str_no)); -#endif /* lint */ - } - - return sp; -} - diff --git a/do/gpent b/do/gpent deleted file mode 100644 index a5cc1c71e0..0000000000 --- a/do/gpent +++ /dev/null @@ -1,61 +0,0 @@ -int -do_gpent(which,gimme,arglast) -int which; -int gimme; -int *arglast; -{ - register ARRAY *ary = stack; - register int sp = arglast[0]; - register char **elem; - register STR *TARG; - struct protoent *getprotobyname(); - struct protoent *getprotobynumber(); - struct protoent *getprotoent(); - struct protoent *pent; - - if (which == O_GPBYNAME) { - char *name = str_get(ary->ary_array[sp+1]); - - pent = getprotobyname(name); - } - else if (which == O_GPBYNUMBER) { - int proto = (int)str_gnum(ary->ary_array[sp+1]); - - pent = getprotobynumber(proto); - } - else - pent = getprotoent(); - - if (gimme != G_ARRAY) { - astore(ary, ++sp, TARG = str_mortal(&str_undef)); - if (pent) { - if (which == O_GPBYNAME) - str_numset(TARG, (double)pent->p_proto); - else - str_set(TARG, pent->p_name); - } - return sp; - } - - if (pent) { -#ifndef lint - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, pent->p_name); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - for (elem = pent->p_aliases; *elem; elem++) { - str_cat(TARG, *elem); - if (elem[1]) - str_ncat(TARG," ",1); - } - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_numset(TARG, (double)pent->p_proto); -#else /* lint */ - elem = Nullch; - elem = elem; - (void)astore(ary, ++sp, str_mortal(&str_no)); -#endif /* lint */ - } - - return sp; -} - diff --git a/do/gpwent b/do/gpwent deleted file mode 100644 index 522cb5b6df..0000000000 --- a/do/gpwent +++ /dev/null @@ -1,86 +0,0 @@ -int -do_gpwent(which,gimme,arglast) -int which; -int gimme; -int *arglast; -{ -#ifdef I_PWD - register ARRAY *ary = stack; - register int sp = arglast[0]; - register STR *TARG; - struct passwd *getpwnam(); - struct passwd *getpwuid(); - struct passwd *getpwent(); - struct passwd *pwent; - - if (which == O_GPWNAM) { - char *name = str_get(ary->ary_array[sp+1]); - - pwent = getpwnam(name); - } - else if (which == O_GPWUID) { - int uid = (int)str_gnum(ary->ary_array[sp+1]); - - pwent = getpwuid(uid); - } - else - pwent = getpwent(); - - if (gimme != G_ARRAY) { - astore(ary, ++sp, TARG = str_mortal(&str_undef)); - if (pwent) { - if (which == O_GPWNAM) - str_numset(TARG, (double)pwent->pw_uid); - else - str_set(TARG, pwent->pw_name); - } - return sp; - } - - if (pwent) { - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, pwent->pw_name); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, pwent->pw_passwd); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_numset(TARG, (double)pwent->pw_uid); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_numset(TARG, (double)pwent->pw_gid); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); -#ifdef PWCHANGE - str_numset(TARG, (double)pwent->pw_change); -#else -#ifdef PWQUOTA - str_numset(TARG, (double)pwent->pw_quota); -#else -#ifdef PWAGE - str_set(TARG, pwent->pw_age); -#endif -#endif -#endif - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); -#ifdef PWCLASS - str_set(TARG,pwent->pw_class); -#else -#ifdef PWCOMMENT - str_set(TARG, pwent->pw_comment); -#endif -#endif - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, pwent->pw_gecos); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, pwent->pw_dir); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, pwent->pw_shell); -#ifdef PWEXPIRE - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_numset(TARG, (double)pwent->pw_expire); -#endif - } - - return sp; -#else - fatal("password routines not implemented"); -#endif -} - diff --git a/do/grep b/do/grep deleted file mode 100644 index 94598ab6ea..0000000000 --- a/do/grep +++ /dev/null @@ -1,49 +0,0 @@ -int -do_grep(arg,TARG,gimme,arglast) -register ARG *arg; -STR *TARG; -int gimme; -int *arglast; -{ - STR **st = stack->ary_array; - register int dst = arglast[1]; - register int src = dst + 1; - register int sp = arglast[2]; - register int i = sp - arglast[1]; - int oldsave = savestack->ary_fill; - SPAT *oldspat = curspat; - int oldtmps_base = tmps_base; - - savesptr(&stab_val(defstab)); - tmps_base = tmps_max; - if ((arg[1].arg_type & A_MASK) != A_EXPR) { - arg[1].arg_type &= A_MASK; - dehoist(arg,1); - arg[1].arg_type |= A_DONT; - } - arg = arg[1].arg_ptr.arg_arg; - while (i-- > 0) { - if (st[src]) { - st[src]->str_pok &= ~SP_TEMP; - stab_val(defstab) = st[src]; - } - else - stab_val(defstab) = str_mortal(&str_undef); - (void)eval(arg,G_SCALAR,sp); - st = stack->ary_array; - if (str_true(st[sp+1])) - st[dst++] = st[src]; - src++; - curspat = oldspat; - } - restorelist(oldsave); - tmps_base = oldtmps_base; - if (gimme != G_ARRAY) { - str_numset(TARG,(double)(dst - arglast[1])); - STABSET(TARG); - st[arglast[0]+1] = TARG; - return arglast[0]+1; - } - return arglast[0] + (dst - arglast[1]); -} - diff --git a/do/gsent b/do/gsent deleted file mode 100644 index ac705164b2..0000000000 --- a/do/gsent +++ /dev/null @@ -1,77 +0,0 @@ -int -do_gsent(which,gimme,arglast) -int which; -int gimme; -int *arglast; -{ - register ARRAY *ary = stack; - register int sp = arglast[0]; - register char **elem; - register STR *TARG; - struct servent *getservbyname(); - struct servent *getservbynumber(); - struct servent *getservent(); - struct servent *sent; - - if (which == O_GSBYNAME) { - char *name = str_get(ary->ary_array[sp+1]); - char *proto = str_get(ary->ary_array[sp+2]); - - if (proto && !*proto) - proto = Nullch; - - sent = getservbyname(name,proto); - } - else if (which == O_GSBYPORT) { - int port = (int)str_gnum(ary->ary_array[sp+1]); - char *proto = str_get(ary->ary_array[sp+2]); - - sent = getservbyport(port,proto); - } - else - sent = getservent(); - - if (gimme != G_ARRAY) { - astore(ary, ++sp, TARG = str_mortal(&str_undef)); - if (sent) { - if (which == O_GSBYNAME) { -#ifdef HAS_NTOHS - str_numset(TARG, (double)ntohs(sent->s_port)); -#else - str_numset(TARG, (double)(sent->s_port)); -#endif - } - else - str_set(TARG, sent->s_name); - } - return sp; - } - - if (sent) { -#ifndef lint - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, sent->s_name); - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - for (elem = sent->s_aliases; *elem; elem++) { - str_cat(TARG, *elem); - if (elem[1]) - str_ncat(TARG," ",1); - } - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); -#ifdef HAS_NTOHS - str_numset(TARG, (double)ntohs(sent->s_port)); -#else - str_numset(TARG, (double)(sent->s_port)); -#endif - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_set(TARG, sent->s_proto); -#else /* lint */ - elem = Nullch; - elem = elem; - (void)astore(ary, ++sp, str_mortal(&str_no)); -#endif /* lint */ - } - - return sp; -} - diff --git a/do/ipcctl b/do/ipcctl deleted file mode 100644 index fb3e2430c6..0000000000 --- a/do/ipcctl +++ /dev/null @@ -1,103 +0,0 @@ -int -do_ipcctl(optype, arglast) -int optype; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[0]; - STR *astr; - char *a; - int id, n, cmd, infosize, getinfo, ret; - - id = (int)str_gnum(st[++sp]); - n = (optype == O_SEMCTL) ? (int)str_gnum(st[++sp]) : 0; - cmd = (int)str_gnum(st[++sp]); - astr = st[++sp]; - - infosize = 0; - getinfo = (cmd == IPC_STAT); - - switch (optype) - { -#ifdef HAS_MSG - case O_MSGCTL: - if (cmd == IPC_STAT || cmd == IPC_SET) - infosize = sizeof(struct msqid_ds); - break; -#endif -#ifdef HAS_SHM - case O_SHMCTL: - if (cmd == IPC_STAT || cmd == IPC_SET) - infosize = sizeof(struct shmid_ds); - break; -#endif -#ifdef HAS_SEM - case O_SEMCTL: - if (cmd == IPC_STAT || cmd == IPC_SET) - infosize = sizeof(struct semid_ds); - else if (cmd == GETALL || cmd == SETALL) - { - struct semid_ds semds; - if (semctl(id, 0, IPC_STAT, &semds) == -1) - return -1; - getinfo = (cmd == GETALL); - infosize = semds.sem_nsems * sizeof(short); - /* "short" is technically wrong but much more portable - than guessing about u_?short(_t)? */ - } - break; -#endif -#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM) - default: - fatal("%s not implemented", opname[optype]); -#endif - } - - if (infosize) - { - if (getinfo) - { - STR_GROW(astr, infosize+1); - a = str_get(astr); - } - else - { - a = str_get(astr); - if (astr->str_cur != infosize) - { - errno = EINVAL; - return -1; - } - } - } - else - { - int i = (int)str_gnum(astr); - a = (char *)i; /* ouch */ - } - errno = 0; - switch (optype) - { -#ifdef HAS_MSG - case O_MSGCTL: - ret = msgctl(id, cmd, (struct msqid_ds *)a); - break; -#endif -#ifdef HAS_SEM - case O_SEMCTL: - ret = semctl(id, n, cmd, a); - break; -#endif -#ifdef HAS_SHM - case O_SHMCTL: - ret = shmctl(id, cmd, (struct shmid_ds *)a); - break; -#endif - } - if (getinfo && ret >= 0) { - astr->str_cur = infosize; - astr->str_ptr[infosize] = '\0'; - } - return ret; -} - diff --git a/do/ipcget b/do/ipcget deleted file mode 100644 index 8eed98e2b0..0000000000 --- a/do/ipcget +++ /dev/null @@ -1,36 +0,0 @@ -int -do_ipcget(optype, arglast) -int optype; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[0]; - key_t key; - int n, flags; - - key = (key_t)str_gnum(st[++sp]); - n = (optype == O_MSGGET) ? 0 : (int)str_gnum(st[++sp]); - flags = (int)str_gnum(st[++sp]); - errno = 0; - switch (optype) - { -#ifdef HAS_MSG - case O_MSGGET: - return msgget(key, flags); -#endif -#ifdef HAS_SEM - case O_SEMGET: - return semget(key, n, flags); -#endif -#ifdef HAS_SHM - case O_SHMGET: - return shmget(key, n, flags); -#endif -#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM) - default: - fatal("%s not implemented", opname[optype]); -#endif - } - return -1; /* should never happen */ -} - diff --git a/do/join b/do/join deleted file mode 100644 index c5c5220099..0000000000 --- a/do/join +++ /dev/null @@ -1,45 +0,0 @@ -void -do_join(TARG,arglast) -register STR *TARG; -int *arglast; -{ - register STR **st = stack->ary_array; - int sp = arglast[1]; - register int items = arglast[2] - sp; - register char *delim = str_get(st[sp]); - register STRLEN len; - int delimlen = st[sp]->str_cur; - - st += sp + 1; - - len = (items > 0 ? (delimlen * (items - 1) ) : 0); - if (TARG->str_len < len + items) { /* current length is way too short */ - while (items-- > 0) { - if (*st) - len += (*st)->str_cur; - st++; - } - STR_GROW(TARG, len + 1); /* so try to pre-extend */ - - items = arglast[2] - sp; - st -= items; - } - - if (items-- > 0) - str_sset(TARG, *st++); - else - str_set(TARG,""); - len = delimlen; - if (len) { - for (; items > 0; items--,st++) { - str_ncat(TARG,delim,len); - str_scat(TARG,*st); - } - } - else { - for (; items > 0; items--,st++) - str_scat(TARG,*st); - } - STABSET(TARG); -} - diff --git a/do/kv b/do/kv deleted file mode 100644 index e433393947..0000000000 --- a/do/kv +++ /dev/null @@ -1,56 +0,0 @@ -int -do_kv(TARG,hash,kv,gimme,arglast) -STR *TARG; -HASH *hash; -int kv; -int gimme; -int *arglast; -{ - register ARRAY *ary = stack; - STR **st = ary->ary_array; - register int sp = arglast[0]; - int i; - register HENT *entry; - char *tmps; - STR *tmpstr; - int dokeys = (kv == O_KEYS || kv == O_HASH); - int dovalues = (kv == O_VALUES || kv == O_HASH); - - if (gimme != G_ARRAY) { - i = 0; - (void)hiterinit(hash); - /*SUPPRESS 560*/ - while (entry = hiternext(hash)) { - i++; - } - str_numset(TARG,(double)i); - STABSET(TARG); - st[++sp] = TARG; - return sp; - } - (void)hiterinit(hash); - /*SUPPRESS 560*/ - while (entry = hiternext(hash)) { - if (dokeys) { - tmps = hiterkey(entry,&i); - if (!i) - tmps = ""; - (void)astore(ary,++sp,str_2mortal(str_make(tmps,i))); - } - if (dovalues) { - tmpstr = Str_new(45,0); -#ifdef DEBUGGING - if (debug & 8192) { - sprintf(buf,"%d%%%d=%d\n",entry->hent_hash, - hash->tbl_max+1,entry->hent_hash & hash->tbl_max); - str_set(tmpstr,buf); - } - else -#endif - str_sset(tmpstr,hiterval(hash,entry)); - (void)astore(ary,++sp,str_2mortal(tmpstr)); - } - } - return sp; -} - diff --git a/do/listen b/do/listen deleted file mode 100644 index 1ec7341d16..0000000000 --- a/do/listen +++ /dev/null @@ -1,27 +0,0 @@ -int -do_listen(stab, arglast) -STAB *stab; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register STIO *stio; - int backlog; - - if (!stab) - goto nuts; - - stio = stab_io(stab); - if (!stio || !stio->ifp) - goto nuts; - - backlog = (int)str_gnum(st[++sp]); - return listen(fileno(stio->ifp), backlog) >= 0; - -nuts: - if (dowarn) - warn("listen() on closed fd"); - errno = EBADF; - return FALSE; -} - diff --git a/do/match b/do/match deleted file mode 100644 index 99197762f0..0000000000 --- a/do/match +++ /dev/null @@ -1,288 +0,0 @@ -int -do_match(TARG,arg,gimme,arglast) -STR *TARG; -register ARG *arg; -int gimme; -int *arglast; -{ - register STR **st = stack->ary_array; - register SPAT *spat = arg[2].arg_ptr.arg_spat; - register char *t; - register int sp = arglast[0] + 1; - STR *srchstr = st[sp]; - register char *s = str_get(st[sp]); - char *strend = s + st[sp]->str_cur; - STR *tmpstr; - char *myhint = hint; - int global; - int safebase; - char *truebase = s; - register REGEXP *rx = spat->spat_regexp; - - hint = Nullch; - if (!spat) { - if (gimme == G_ARRAY) - return --sp; - str_set(TARG,Yes); - STABSET(TARG); - st[sp] = TARG; - return sp; - } - global = spat->spat_flags & SPAT_GLOBAL; - safebase = (gimme == G_ARRAY) || global; - if (!s) - fatal("panic: do_match"); - if (spat->spat_flags & SPAT_USED) { -#ifdef DEBUGGING - if (debug & 8) - deb("2.SPAT USED\n"); -#endif - if (gimme == G_ARRAY) - return --sp; - str_set(TARG,No); - STABSET(TARG); - st[sp] = TARG; - return sp; - } - --sp; - if (spat->spat_runtime) { - nointrp = "|)"; - sp = eval(spat->spat_runtime,G_SCALAR,sp); - st = stack->ary_array; - t = str_get(tmpstr = st[sp--]); - nointrp = ""; -#ifdef DEBUGGING - if (debug & 8) - deb("2.SPAT /%s/\n",t); -#endif - if (!global && rx) - regfree(rx); - spat->spat_regexp = Null(REGEXP*); /* crucial if regcomp aborts */ - spat->spat_regexp = regcomp(t,t+tmpstr->str_cur, - spat->spat_flags & SPAT_FOLD); - if (!spat->spat_regexp->prelen && lastspat) - spat = lastspat; - if (spat->spat_flags & SPAT_KEEP) { - if (!(spat->spat_flags & SPAT_FOLD)) - scanconst(spat,spat->spat_regexp->precomp, - spat->spat_regexp->prelen); - if (spat->spat_runtime) - arg_free(spat->spat_runtime); /* it won't change, so */ - spat->spat_runtime = Nullarg; /* no point compiling again */ - hoistmust(spat); - if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) { - curcmd->c_flags &= ~CF_OPTIMIZE; - opt_arg(curcmd, 1, curcmd->c_type == C_EXPR); - } - } - if (global) { - if (rx) { - if (rx->startp[0]) { - s = rx->endp[0]; - if (s == rx->startp[0]) - s++; - if (s > strend) { - regfree(rx); - rx = spat->spat_regexp; - goto nope; - } - } - regfree(rx); - } - } - else if (!spat->spat_regexp->nparens) - gimme = G_SCALAR; /* accidental array context? */ - rx = spat->spat_regexp; - if (regexec(rx, s, strend, s, 0, - srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr, - safebase)) { - if (rx->subbase || global) - curspat = spat; - lastspat = spat; - goto gotcha; - } - else { - if (gimme == G_ARRAY) - return sp; - str_sset(TARG,&str_no); - STABSET(TARG); - st[++sp] = TARG; - return sp; - } - } - else { -#ifdef DEBUGGING - if (debug & 8) { - char ch; - - if (spat->spat_flags & SPAT_ONCE) - ch = '?'; - else - ch = '/'; - deb("2.SPAT %c%s%c\n",ch,rx->precomp,ch); - } -#endif - if (!rx->prelen && lastspat) { - spat = lastspat; - rx = spat->spat_regexp; - } - t = s; - play_it_again: - if (global && rx->startp[0]) { - t = s = rx->endp[0]; - if (s == rx->startp[0]) - s++,t++; - if (s > strend) - goto nope; - } - if (myhint) { - if (myhint < s || myhint > strend) - fatal("panic: hint in do_match"); - s = myhint; - if (rx->regback >= 0) { - s -= rx->regback; - if (s < t) - s = t; - } - else - s = t; - } - else if (spat->spat_short) { - if (spat->spat_flags & SPAT_SCANFIRST) { - if (srchstr->str_pok & SP_STUDIED) { - if (screamfirst[spat->spat_short->str_rare] < 0) - goto nope; - else if (!(s = screaminstr(srchstr,spat->spat_short))) - goto nope; - else if (spat->spat_flags & SPAT_ALL) - goto yup; - } -#ifndef lint - else if (!(s = fbminstr((unsigned char*)s, - (unsigned char*)strend, spat->spat_short))) - goto nope; -#endif - else if (spat->spat_flags & SPAT_ALL) - goto yup; - if (s && rx->regback >= 0) { - ++spat->spat_short->str_u.str_useful; - s -= rx->regback; - if (s < t) - s = t; - } - else - s = t; - } - else if (!multiline && (*spat->spat_short->str_ptr != *s || - bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) )) - goto nope; - if (--spat->spat_short->str_u.str_useful < 0) { - str_free(spat->spat_short); - spat->spat_short = Nullstr; /* opt is being useless */ - } - } - if (!rx->nparens && !global) { - gimme = G_SCALAR; /* accidental array context? */ - safebase = FALSE; - } - if (regexec(rx, s, strend, truebase, 0, - srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr, - safebase)) { - if (rx->subbase || global) - curspat = spat; - lastspat = spat; - if (spat->spat_flags & SPAT_ONCE) - spat->spat_flags |= SPAT_USED; - goto gotcha; - } - else { - if (global) - rx->startp[0] = Nullch; - if (gimme == G_ARRAY) - return sp; - str_sset(TARG,&str_no); - STABSET(TARG); - st[++sp] = TARG; - return sp; - } - } - /*NOTREACHED*/ - - gotcha: - if (gimme == G_ARRAY) { - int iters, i, len; - - iters = rx->nparens; - if (global && !iters) - i = 1; - else - i = 0; - if (sp + iters + i >= stack->ary_max) { - astore(stack,sp + iters + i, Nullstr); - st = stack->ary_array; /* possibly realloced */ - } - - for (i = !i; i <= iters; i++) { - st[++sp] = str_mortal(&str_no); - /*SUPPRESS 560*/ - if (s = rx->startp[i]) { - len = rx->endp[i] - s; - if (len > 0) - str_nset(st[sp],s,len); - } - } - if (global) { - truebase = rx->subbeg; - goto play_it_again; - } - return sp; - } - else { - str_sset(TARG,&str_yes); - STABSET(TARG); - st[++sp] = TARG; - return sp; - } - -yup: - ++spat->spat_short->str_u.str_useful; - lastspat = spat; - if (spat->spat_flags & SPAT_ONCE) - spat->spat_flags |= SPAT_USED; - if (global) { - rx->subbeg = t; - rx->subend = strend; - rx->startp[0] = s; - rx->endp[0] = s + spat->spat_short->str_cur; - curspat = spat; - goto gotcha; - } - if (sawampersand) { - char *tmps; - - if (rx->subbase) - Safefree(rx->subbase); - tmps = rx->subbase = nsavestr(t,strend-t); - rx->subbeg = tmps; - rx->subend = tmps + (strend-t); - tmps = rx->startp[0] = tmps + (s - t); - rx->endp[0] = tmps + spat->spat_short->str_cur; - curspat = spat; - } - str_sset(TARG,&str_yes); - STABSET(TARG); - st[++sp] = TARG; - return sp; - -nope: - rx->startp[0] = Nullch; - if (spat->spat_short) - ++spat->spat_short->str_u.str_useful; - if (gimme == G_ARRAY) - return sp; - str_sset(TARG,&str_no); - STABSET(TARG); - st[++sp] = TARG; - return sp; -} - diff --git a/do/msgrcv b/do/msgrcv deleted file mode 100644 index d687664721..0000000000 --- a/do/msgrcv +++ /dev/null @@ -1,34 +0,0 @@ -int -do_msgrcv(arglast) -int *arglast; -{ -#ifdef HAS_MSG - register STR **st = stack->ary_array; - register int sp = arglast[0]; - STR *mstr; - char *mbuf; - long mtype; - int id, msize, flags, ret; - - id = (int)str_gnum(st[++sp]); - mstr = st[++sp]; - msize = (int)str_gnum(st[++sp]); - mtype = (long)str_gnum(st[++sp]); - flags = (int)str_gnum(st[++sp]); - mbuf = str_get(mstr); - if (mstr->str_cur < sizeof(long)+msize+1) { - STR_GROW(mstr, sizeof(long)+msize+1); - mbuf = str_get(mstr); - } - errno = 0; - ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags); - if (ret >= 0) { - mstr->str_cur = sizeof(long)+ret; - mstr->str_ptr[sizeof(long)+ret] = '\0'; - } - return ret; -#else - fatal("msgrcv not implemented"); -#endif -} - diff --git a/do/msgsnd b/do/msgsnd deleted file mode 100644 index 700a662a23..0000000000 --- a/do/msgsnd +++ /dev/null @@ -1,26 +0,0 @@ -int -do_msgsnd(arglast) -int *arglast; -{ -#ifdef HAS_MSG - register STR **st = stack->ary_array; - register int sp = arglast[0]; - STR *mstr; - char *mbuf; - int id, msize, flags; - - id = (int)str_gnum(st[++sp]); - mstr = st[++sp]; - flags = (int)str_gnum(st[++sp]); - mbuf = str_get(mstr); - if ((msize = mstr->str_cur - sizeof(long)) < 0) { - errno = EINVAL; - return -1; - } - errno = 0; - return msgsnd(id, (struct msgbuf *)mbuf, msize, flags); -#else - fatal("msgsnd not implemented"); -#endif -} - diff --git a/do/open b/do/open deleted file mode 100644 index 339b3ba9df..0000000000 --- a/do/open +++ /dev/null @@ -1,239 +0,0 @@ -bool -do_open(stab,name,len) -STAB *stab; -register char *name; -int len; -{ - FILE *fp; - register STIO *stio = stab_io(stab); - char *myname = savestr(name); - int result; - int fd; - int writing = 0; - char mode[3]; /* stdio file mode ("r\0" or "r+\0") */ - FILE *saveifp = Nullfp; - FILE *saveofp = Nullfp; - char savetype = ' '; - - mode[0] = mode[1] = mode[2] = '\0'; - name = myname; - forkprocess = 1; /* assume true if no fork */ - while (len && isSPACE(name[len-1])) - name[--len] = '\0'; - if (!stio) - stio = stab_io(stab) = stio_new(); - else if (stio->ifp) { - fd = fileno(stio->ifp); - if (stio->type == '-') - result = 0; - else if (fd <= maxsysfd) { - saveifp = stio->ifp; - saveofp = stio->ofp; - savetype = stio->type; - result = 0; - } - else if (stio->type == '|') - result = mypclose(stio->ifp); - else if (stio->ifp != stio->ofp) { - if (stio->ofp) { - result = fclose(stio->ofp); - fclose(stio->ifp); /* clear stdio, fd already closed */ - } - else - result = fclose(stio->ifp); - } - else - result = fclose(stio->ifp); - if (result == EOF && fd > maxsysfd) - fprintf(stderr,"Warning: unable to close filehandle %s properly.\n", - stab_ename(stab)); - stio->ofp = stio->ifp = Nullfp; - } - if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */ - mode[1] = *name++; - mode[2] = '\0'; - --len; - writing = 1; - } - else { - mode[1] = '\0'; - } - stio->type = *name; - if (*name == '|') { - /*SUPPRESS 530*/ - for (name++; isSPACE(*name); name++) ; - TAINT_ENV(); - TAINT_PROPER("piped open"); - fp = mypopen(name,"w"); - writing = 1; - } - else if (*name == '>') { - TAINT_PROPER("open"); - name++; - if (*name == '>') { - mode[0] = stio->type = 'a'; - name++; - } - else - mode[0] = 'w'; - writing = 1; - if (*name == '&') { - duplicity: - name++; - while (isSPACE(*name)) - name++; - if (isDIGIT(*name)) - fd = atoi(name); - else { - stab = stabent(name,FALSE); - if (!stab || !stab_io(stab)) { -#ifdef EINVAL - errno = EINVAL; -#endif - goto say_false; - } - if (stab_io(stab) && stab_io(stab)->ifp) { - fd = fileno(stab_io(stab)->ifp); - if (stab_io(stab)->type == 's') - stio->type = 's'; - } - else - fd = -1; - } - if (!(fp = fdopen(fd = dup(fd),mode))) { - close(fd); - } - } - else { - while (isSPACE(*name)) - name++; - if (strEQ(name,"-")) { - fp = stdout; - stio->type = '-'; - } - else { - fp = fopen(name,mode); - } - } - } - else { - if (*name == '<') { - mode[0] = 'r'; - name++; - while (isSPACE(*name)) - name++; - if (*name == '&') - goto duplicity; - if (strEQ(name,"-")) { - fp = stdin; - stio->type = '-'; - } - else - fp = fopen(name,mode); - } - else if (name[len-1] == '|') { - TAINT_ENV(); - TAINT_PROPER("piped open"); - name[--len] = '\0'; - while (len && isSPACE(name[len-1])) - name[--len] = '\0'; - /*SUPPRESS 530*/ - for (; isSPACE(*name); name++) ; - fp = mypopen(name,"r"); - stio->type = '|'; - } - else { - stio->type = '<'; - /*SUPPRESS 530*/ - for (; isSPACE(*name); name++) ; - if (strEQ(name,"-")) { - fp = stdin; - stio->type = '-'; - } - else - fp = fopen(name,"r"); - } - } - if (!fp) { - if (dowarn && stio->type == '<' && index(name, '\n')) - warn(warn_nl, "open"); - Safefree(myname); - goto say_false; - } - Safefree(myname); - if (stio->type && - stio->type != '|' && stio->type != '-') { - if (fstat(fileno(fp),&statbuf) < 0) { - (void)fclose(fp); - goto say_false; - } - if (S_ISSOCK(statbuf.st_mode)) - stio->type = 's'; /* in case a socket was passed in to us */ -#ifdef HAS_SOCKET - else if ( -#ifdef S_IFMT - !(statbuf.st_mode & S_IFMT) -#else - !statbuf.st_mode -#endif - ) { - int buflen = sizeof tokenbuf; - if (getsockname(fileno(fp), tokenbuf, &buflen) >= 0 - || errno != ENOTSOCK) - stio->type = 's'; /* some OS's return 0 on fstat()ed socket */ - /* but some return 0 for streams too, sigh */ - } -#endif - } - if (saveifp) { /* must use old fp? */ - fd = fileno(saveifp); - if (saveofp) { - fflush(saveofp); /* emulate fclose() */ - if (saveofp != saveifp) { /* was a socket? */ - fclose(saveofp); - if (fd > 2) - Safefree(saveofp); - } - } - if (fd != fileno(fp)) { - int pid; - STR *TARG; - - dup2(fileno(fp), fd); - TARG = afetch(fdpid,fileno(fp),TRUE); - pid = TARG->str_u.str_useful; - TARG->str_u.str_useful = 0; - TARG = afetch(fdpid,fd,TRUE); - TARG->str_u.str_useful = pid; - fclose(fp); - - } - fp = saveifp; - clearerr(fp); - } -#if defined(HAS_FCNTL) && defined(F_SETFD) - fd = fileno(fp); - fcntl(fd,F_SETFD,fd > maxsysfd); -#endif - stio->ifp = fp; - if (writing) { - if (stio->type == 's' - || (stio->type == '>' && S_ISCHR(statbuf.st_mode)) ) { - if (!(stio->ofp = fdopen(fileno(fp),"w"))) { - fclose(fp); - stio->ifp = Nullfp; - goto say_false; - } - } - else - stio->ofp = fp; - } - return TRUE; - -say_false: - stio->ifp = saveifp; - stio->ofp = saveofp; - stio->type = savetype; - return FALSE; -} - diff --git a/do/pack b/do/pack deleted file mode 100644 index 96e8bd5f37..0000000000 --- a/do/pack +++ /dev/null @@ -1,399 +0,0 @@ -void -do_pack(TARG,arglast) -register STR *TARG; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int items; - register char *pat = str_get(st[sp]); - register char *patend = pat + st[sp]->str_cur; - register int len; - int datumtype; - STR *fromstr; - /*SUPPRESS 442*/ - static char *null10 = "\0\0\0\0\0\0\0\0\0\0"; - static char *space10 = " "; - - /* These must not be in registers: */ - char achar; - short ashort; - int aint; - unsigned int auint; - long along; - unsigned long aulong; -#ifdef QUAD - quad aquad; - unsigned quad auquad; -#endif - char *aptr; - float afloat; - double adouble; - - items = arglast[2] - sp; - st += ++sp; - str_nset(TARG,"",0); - while (pat < patend) { -#define NEXTFROM (items-- > 0 ? *st++ : &str_no) - datumtype = *pat++; - if (*pat == '*') { - len = index("@Xxu",datumtype) ? 0 : items; - pat++; - } - else if (isDIGIT(*pat)) { - len = *pat++ - '0'; - while (isDIGIT(*pat)) - len = (len * 10) + (*pat++ - '0'); - } - else - len = 1; - switch(datumtype) { - default: - break; - case '%': - fatal("% may only be used in unpack"); - case '@': - len -= TARG->str_cur; - if (len > 0) - goto grow; - len = -len; - if (len > 0) - goto shrink; - break; - case 'X': - shrink: - if (TARG->str_cur < len) - fatal("X outside of string"); - TARG->str_cur -= len; - TARG->str_ptr[TARG->str_cur] = '\0'; - break; - case 'x': - grow: - while (len >= 10) { - str_ncat(TARG,null10,10); - len -= 10; - } - str_ncat(TARG,null10,len); - break; - case 'A': - case 'a': - fromstr = NEXTFROM; - aptr = str_get(fromstr); - if (pat[-1] == '*') - len = fromstr->str_cur; - if (fromstr->str_cur > len) - str_ncat(TARG,aptr,len); - else { - str_ncat(TARG,aptr,fromstr->str_cur); - len -= fromstr->str_cur; - if (datumtype == 'A') { - while (len >= 10) { - str_ncat(TARG,space10,10); - len -= 10; - } - str_ncat(TARG,space10,len); - } - else { - while (len >= 10) { - str_ncat(TARG,null10,10); - len -= 10; - } - str_ncat(TARG,null10,len); - } - } - break; - case 'B': - case 'b': - { - char *savepat = pat; - int saveitems; - - fromstr = NEXTFROM; - saveitems = items; - aptr = str_get(fromstr); - if (pat[-1] == '*') - len = fromstr->str_cur; - pat = aptr; - aint = TARG->str_cur; - TARG->str_cur += (len+7)/8; - STR_GROW(TARG, TARG->str_cur + 1); - aptr = TARG->str_ptr + aint; - if (len > fromstr->str_cur) - len = fromstr->str_cur; - aint = len; - items = 0; - if (datumtype == 'B') { - for (len = 0; len++ < aint;) { - items |= *pat++ & 1; - if (len & 7) - items <<= 1; - else { - *aptr++ = items & 0xff; - items = 0; - } - } - } - else { - for (len = 0; len++ < aint;) { - if (*pat++ & 1) - items |= 128; - if (len & 7) - items >>= 1; - else { - *aptr++ = items & 0xff; - items = 0; - } - } - } - if (aint & 7) { - if (datumtype == 'B') - items <<= 7 - (aint & 7); - else - items >>= 7 - (aint & 7); - *aptr++ = items & 0xff; - } - pat = TARG->str_ptr + TARG->str_cur; - while (aptr <= pat) - *aptr++ = '\0'; - - pat = savepat; - items = saveitems; - } - break; - case 'H': - case 'h': - { - char *savepat = pat; - int saveitems; - - fromstr = NEXTFROM; - saveitems = items; - aptr = str_get(fromstr); - if (pat[-1] == '*') - len = fromstr->str_cur; - pat = aptr; - aint = TARG->str_cur; - TARG->str_cur += (len+1)/2; - STR_GROW(TARG, TARG->str_cur + 1); - aptr = TARG->str_ptr + aint; - if (len > fromstr->str_cur) - len = fromstr->str_cur; - aint = len; - items = 0; - if (datumtype == 'H') { - for (len = 0; len++ < aint;) { - if (isALPHA(*pat)) - items |= ((*pat++ & 15) + 9) & 15; - else - items |= *pat++ & 15; - if (len & 1) - items <<= 4; - else { - *aptr++ = items & 0xff; - items = 0; - } - } - } - else { - for (len = 0; len++ < aint;) { - if (isALPHA(*pat)) - items |= (((*pat++ & 15) + 9) & 15) << 4; - else - items |= (*pat++ & 15) << 4; - if (len & 1) - items >>= 4; - else { - *aptr++ = items & 0xff; - items = 0; - } - } - } - if (aint & 1) - *aptr++ = items & 0xff; - pat = TARG->str_ptr + TARG->str_cur; - while (aptr <= pat) - *aptr++ = '\0'; - - pat = savepat; - items = saveitems; - } - break; - case 'C': - case 'c': - while (len-- > 0) { - fromstr = NEXTFROM; - aint = (int)str_gnum(fromstr); - achar = aint; - str_ncat(TARG,&achar,sizeof(char)); - } - break; - /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */ - case 'f': - case 'F': - while (len-- > 0) { - fromstr = NEXTFROM; - afloat = (float)str_gnum(fromstr); - str_ncat(TARG, (char *)&afloat, sizeof (float)); - } - break; - case 'd': - case 'D': - while (len-- > 0) { - fromstr = NEXTFROM; - adouble = (double)str_gnum(fromstr); - str_ncat(TARG, (char *)&adouble, sizeof (double)); - } - break; - case 'n': - while (len-- > 0) { - fromstr = NEXTFROM; - ashort = (short)str_gnum(fromstr); -#ifdef HAS_HTONS - ashort = htons(ashort); -#endif - str_ncat(TARG,(char*)&ashort,sizeof(short)); - } - break; - case 'v': - while (len-- > 0) { - fromstr = NEXTFROM; - ashort = (short)str_gnum(fromstr); -#ifdef HAS_HTOVS - ashort = htovs(ashort); -#endif - str_ncat(TARG,(char*)&ashort,sizeof(short)); - } - break; - case 'S': - case 's': - while (len-- > 0) { - fromstr = NEXTFROM; - ashort = (short)str_gnum(fromstr); - str_ncat(TARG,(char*)&ashort,sizeof(short)); - } - break; - case 'I': - while (len-- > 0) { - fromstr = NEXTFROM; - auint = U_I(str_gnum(fromstr)); - str_ncat(TARG,(char*)&auint,sizeof(unsigned int)); - } - break; - case 'i': - while (len-- > 0) { - fromstr = NEXTFROM; - aint = (int)str_gnum(fromstr); - str_ncat(TARG,(char*)&aint,sizeof(int)); - } - break; - case 'N': - while (len-- > 0) { - fromstr = NEXTFROM; - aulong = U_L(str_gnum(fromstr)); -#ifdef HAS_HTONL - aulong = htonl(aulong); -#endif - str_ncat(TARG,(char*)&aulong,sizeof(unsigned long)); - } - break; - case 'V': - while (len-- > 0) { - fromstr = NEXTFROM; - aulong = U_L(str_gnum(fromstr)); -#ifdef HAS_HTOVL - aulong = htovl(aulong); -#endif - str_ncat(TARG,(char*)&aulong,sizeof(unsigned long)); - } - break; - case 'L': - while (len-- > 0) { - fromstr = NEXTFROM; - aulong = U_L(str_gnum(fromstr)); - str_ncat(TARG,(char*)&aulong,sizeof(unsigned long)); - } - break; - case 'l': - while (len-- > 0) { - fromstr = NEXTFROM; - along = (long)str_gnum(fromstr); - str_ncat(TARG,(char*)&along,sizeof(long)); - } - break; -#ifdef QUAD - case 'Q': - while (len-- > 0) { - fromstr = NEXTFROM; - auquad = (unsigned quad)str_gnum(fromstr); - str_ncat(TARG,(char*)&auquad,sizeof(unsigned quad)); - } - break; - case 'q': - while (len-- > 0) { - fromstr = NEXTFROM; - aquad = (quad)str_gnum(fromstr); - str_ncat(TARG,(char*)&aquad,sizeof(quad)); - } - break; -#endif /* QUAD */ - case 'p': - while (len-- > 0) { - fromstr = NEXTFROM; - aptr = str_get(fromstr); - str_ncat(TARG,(char*)&aptr,sizeof(char*)); - } - break; - case 'u': - fromstr = NEXTFROM; - aptr = str_get(fromstr); - aint = fromstr->str_cur; - STR_GROW(TARG,aint * 4 / 3); - if (len <= 1) - len = 45; - else - len = len / 3 * 3; - while (aint > 0) { - int todo; - - if (aint > len) - todo = len; - else - todo = aint; - doencodes(TARG, aptr, todo); - aint -= todo; - aptr += todo; - } - break; - } - } - STABSET(TARG); -} -#undef NEXTFROM - -static void -doencodes(TARG, s, len) -register STR *TARG; -register char *s; -register int len; -{ - char hunk[5]; - - *hunk = len + ' '; - str_ncat(TARG, hunk, 1); - hunk[4] = '\0'; - while (len > 0) { - hunk[0] = ' ' + (077 & (*s >> 2)); - hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017)); - hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03)); - hunk[3] = ' ' + (077 & (s[2] & 077)); - str_ncat(TARG, hunk, 4); - s += 3; - len -= 3; - } - for (s = TARG->str_ptr; *s; s++) { - if (*s == ' ') - *s = '`'; - } - str_ncat(TARG, "\n", 1); -} - diff --git a/do/pipe b/do/pipe deleted file mode 100644 index b3a6216d73..0000000000 --- a/do/pipe +++ /dev/null @@ -1,52 +0,0 @@ -#ifdef HAS_PIPE -void -do_pipe(TARG, rstab, wstab) -STR *TARG; -STAB *rstab; -STAB *wstab; -{ - register STIO *rstio; - register STIO *wstio; - int fd[2]; - - if (!rstab) - goto badexit; - if (!wstab) - goto badexit; - - rstio = stab_io(rstab); - wstio = stab_io(wstab); - - if (!rstio) - rstio = stab_io(rstab) = stio_new(); - else if (rstio->ifp) - do_close(rstab,FALSE); - if (!wstio) - wstio = stab_io(wstab) = stio_new(); - else if (wstio->ifp) - do_close(wstab,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); - else close(fd[0]); - if (wstio->ofp) fclose(wstio->ofp); - else close(fd[1]); - goto badexit; - } - - str_sset(TARG,&str_yes); - return; - -badexit: - str_sset(TARG,&str_undef); - return; -} -#endif - diff --git a/do/print b/do/print deleted file mode 100644 index ea3acc6e76..0000000000 --- a/do/print +++ /dev/null @@ -1,37 +0,0 @@ -bool -do_print(TARG,fp) -register STR *TARG; -FILE *fp; -{ - register char *tmps; - - if (!fp) { - if (dowarn) - warn("print to unopened file"); - errno = EBADF; - return FALSE; - } - if (!TARG) - return TRUE; - if (ofmt && - ((TARG->str_nok && TARG->str_u.str_nval != 0.0) - || (looks_like_number(TARG) && str_gnum(TARG) != 0.0) ) ) { - fprintf(fp, ofmt, TARG->str_u.str_nval); - return !ferror(fp); - } - else { - tmps = str_get(TARG); - if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'B' && tmps[3] == '\0' - && TARG->str_cur == sizeof(STBP) && strlen(tmps) < TARG->str_cur) { - STR *tmpstr = str_mortal(&str_undef); - stab_efullname(tmpstr,((STAB*)TARG));/* a stab value, be nice */ - TARG = tmpstr; - tmps = TARG->str_ptr; - putc('*',fp); - } - if (TARG->str_cur && (fwrite(tmps,1,TARG->str_cur,fp) == 0 || ferror(fp))) - return FALSE; - } - return TRUE; -} - diff --git a/do/push b/do/push deleted file mode 100644 index 8ff5b2400c..0000000000 --- a/do/push +++ /dev/null @@ -1,19 +0,0 @@ -STR * -do_push(ary,arglast) -register ARRAY *ary; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int items = arglast[2] - sp; - register STR *TARG = &str_undef; - - for (st += ++sp; items > 0; items--,st++) { - TARG = Str_new(26,0); - if (*st) - str_sset(TARG,*st); - (void)apush(ary,TARG); - } - return TARG; -} - diff --git a/do/range b/do/range deleted file mode 100644 index f28bcd7cfc..0000000000 --- a/do/range +++ /dev/null @@ -1,43 +0,0 @@ -int -do_range(gimme,arglast) -int gimme; -int *arglast; -{ - STR **st = stack->ary_array; - register int sp = arglast[0]; - register int i; - register ARRAY *ary = stack; - register STR *TARG; - int max; - - if (gimme != G_ARRAY) - fatal("panic: do_range"); - - if (st[sp+1]->str_nok || !st[sp+1]->str_pok || - (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) { - i = (int)str_gnum(st[sp+1]); - max = (int)str_gnum(st[sp+2]); - if (max > i) - (void)astore(ary, sp + max - i + 1, Nullstr); - while (i <= max) { - (void)astore(ary, ++sp, TARG = str_mortal(&str_no)); - str_numset(TARG,(double)i++); - } - } - else { - STR *final = str_mortal(st[sp+2]); - char *tmps = str_get(final); - - TARG = str_mortal(st[sp+1]); - while (!TARG->str_nok && TARG->str_cur <= final->str_cur && - strNE(TARG->str_ptr,tmps) ) { - (void)astore(ary, ++sp, TARG); - TARG = str_2mortal(str_smake(TARG)); - str_inc(TARG); - } - if (strEQ(TARG->str_ptr,tmps)) - (void)astore(ary, ++sp, TARG); - } - return sp; -} - diff --git a/do/repeatary b/do/repeatary deleted file mode 100644 index 856a83d31f..0000000000 --- a/do/repeatary +++ /dev/null @@ -1,25 +0,0 @@ -int -do_repeatary(ARGS) -ARGSdecl -{ - MSP; - register int count = POPi; - register int items = sp - mark; - register int i; - int max; - - max = items * count; - MEXTEND(mark,max); - if (count > 1) { - while (sp > mark) { - if (*sp) - (*sp)->str_pok &= ~SP_TEMP; - } - mark++; - repeatcpy(mark + items, mark, items * sizeof(STR*), count - 1); - } - sp += max; - - MRETURN; -} - diff --git a/do/reverse b/do/reverse deleted file mode 100644 index 32598ab7d1..0000000000 --- a/do/reverse +++ /dev/null @@ -1,19 +0,0 @@ -int -do_reverse(arglast) -int *arglast; -{ - STR **st = stack->ary_array; - register STR **up = &st[arglast[1]]; - register STR **down = &st[arglast[2]]; - register int i = arglast[2] - arglast[1]; - - while (i-- > 0) { - *up++ = *down; - if (i-- > 0) - *down-- = *up; - } - i = arglast[2] - arglast[1]; - Move(down+1,up,i/2,STR*); - return arglast[2] - 1; -} - diff --git a/do/seek b/do/seek deleted file mode 100644 index c295ea7f66..0000000000 --- a/do/seek +++ /dev/null @@ -1,29 +0,0 @@ -bool -do_seek(stab, pos, whence) -STAB *stab; -long pos; -int whence; -{ - register STIO *stio; - - if (!stab) - goto nuts; - - stio = stab_io(stab); - if (!stio || !stio->ifp) - goto nuts; - -#ifdef ULTRIX_STDIO_BOTCH - if (feof(stio->ifp)) - (void)fseek (stio->ifp, 0L, 2); /* ultrix 1.2 workaround */ -#endif - - return fseek(stio->ifp, pos, whence) >= 0; - -nuts: - if (dowarn) - warn("seek() on unopened file"); - errno = EBADF; - return FALSE; -} - diff --git a/do/select b/do/select deleted file mode 100644 index 3821193115..0000000000 --- a/do/select +++ /dev/null @@ -1,133 +0,0 @@ -#ifdef HAS_SELECT -int -do_select(gimme,arglast) -int gimme; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[0]; - register int i; - register int j; - register char *s; - register STR *TARG; - double value; - int maxlen = 0; - int nfound; - struct timeval timebuf; - struct timeval *tbuf = &timebuf; - int growsize; -#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 - int masksize; - int offset; - char *fd_sets[4]; - int k; - -#if BYTEORDER & 0xf0000 -#define ORDERBYTE (0x88888888 - BYTEORDER) -#else -#define ORDERBYTE (0x4444 - BYTEORDER) -#endif - -#endif - - for (i = 1; i <= 3; i++) { - j = st[sp+i]->str_cur; - if (maxlen < j) - maxlen = j; - } - -#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 - growsize = maxlen; /* little endians can use vecs directly */ -#else -#ifdef NFDBITS - -#ifndef NBBY -#define NBBY 8 -#endif - - masksize = NFDBITS / NBBY; -#else - masksize = sizeof(long); /* documented int, everyone seems to use long */ -#endif - growsize = maxlen + (masksize - (maxlen % masksize)); - Zero(&fd_sets[0], 4, char*); -#endif - - for (i = 1; i <= 3; i++) { - TARG = st[sp+i]; - j = TARG->str_len; - if (j < growsize) { - if (TARG->str_pok) { - Str_Grow(TARG,growsize); - s = str_get(TARG) + j; - while (++j <= growsize) { - *s++ = '\0'; - } - } - else if (TARG->str_ptr) { - Safefree(TARG->str_ptr); - TARG->str_ptr = Nullch; - } - } -#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 - s = TARG->str_ptr; - if (s) { - New(403, fd_sets[i], growsize, char); - for (offset = 0; offset < growsize; offset += masksize) { - for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) - fd_sets[i][j+offset] = s[(k % masksize) + offset]; - } - } -#endif - } - TARG = st[sp+4]; - if (TARG->str_nok || TARG->str_pok) { - value = str_gnum(TARG); - if (value < 0.0) - value = 0.0; - timebuf.tv_sec = (long)value; - value -= (double)timebuf.tv_sec; - timebuf.tv_usec = (long)(value * 1000000.0); - } - else - tbuf = Null(struct timeval*); - -#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 - nfound = select( - maxlen * 8, - st[sp+1]->str_ptr, - st[sp+2]->str_ptr, - st[sp+3]->str_ptr, - tbuf); -#else - nfound = select( - maxlen * 8, - fd_sets[1], - fd_sets[2], - fd_sets[3], - tbuf); - for (i = 1; i <= 3; i++) { - if (fd_sets[i]) { - TARG = st[sp+i]; - s = TARG->str_ptr; - for (offset = 0; offset < growsize; offset += masksize) { - for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) - s[(k % masksize) + offset] = fd_sets[i][j+offset]; - } - Safefree(fd_sets[i]); - } - } -#endif - - st[++sp] = str_mortal(&str_no); - str_numset(st[sp], (double)nfound); - if (gimme == G_ARRAY && tbuf) { - value = (double)(timebuf.tv_sec) + - (double)(timebuf.tv_usec) / 1000000.0; - st[++sp] = str_mortal(&str_no); - str_numset(st[sp], value); - } - return sp; -} -#endif /* SELECT */ - diff --git a/do/semop b/do/semop deleted file mode 100644 index 9a4ec11f4a..0000000000 --- a/do/semop +++ /dev/null @@ -1,27 +0,0 @@ -int -do_semop(arglast) -int *arglast; -{ -#ifdef HAS_SEM - register STR **st = stack->ary_array; - register int sp = arglast[0]; - STR *opstr; - char *opbuf; - int id, opsize; - - id = (int)str_gnum(st[++sp]); - opstr = st[++sp]; - opbuf = str_get(opstr); - opsize = opstr->str_cur; - if (opsize < sizeof(struct sembuf) - || (opsize % sizeof(struct sembuf)) != 0) { - errno = EINVAL; - return -1; - } - errno = 0; - return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf)); -#else - fatal("semop not implemented"); -#endif -} - diff --git a/do/shmio b/do/shmio deleted file mode 100644 index b7107684ac..0000000000 --- a/do/shmio +++ /dev/null @@ -1,55 +0,0 @@ -int -do_shmio(optype, arglast) -int optype; -int *arglast; -{ -#ifdef HAS_SHM - register STR **st = stack->ary_array; - register int sp = arglast[0]; - STR *mstr; - char *mbuf, *shm; - int id, mpos, msize; - struct shmid_ds shmds; -#ifndef VOIDSHMAT - extern char *shmat(); -#endif - - id = (int)str_gnum(st[++sp]); - mstr = st[++sp]; - mpos = (int)str_gnum(st[++sp]); - msize = (int)str_gnum(st[++sp]); - errno = 0; - if (shmctl(id, IPC_STAT, &shmds) == -1) - return -1; - if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) { - errno = EFAULT; /* can't do as caller requested */ - return -1; - } - shm = (char*)shmat(id, (char*)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0); - if (shm == (char *)-1) /* I hate System V IPC, I really do */ - return -1; - mbuf = str_get(mstr); - if (optype == O_SHMREAD) { - if (mstr->str_cur < msize) { - STR_GROW(mstr, msize+1); - mbuf = str_get(mstr); - } - Copy(shm + mpos, mbuf, msize, char); - mstr->str_cur = msize; - mstr->str_ptr[msize] = '\0'; - } - else { - int n; - - if ((n = mstr->str_cur) > msize) - n = msize; - Copy(mbuf, shm + mpos, n, char); - if (n < msize) - memzero(shm + mpos + n, msize - n); - } - return shmdt(shm); -#else - fatal("shm I/O not implemented"); -#endif -} - diff --git a/do/shutdown b/do/shutdown deleted file mode 100644 index 11917076d4..0000000000 --- a/do/shutdown +++ /dev/null @@ -1,28 +0,0 @@ -int -do_shutdown(stab, arglast) -STAB *stab; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register STIO *stio; - int how; - - if (!stab) - goto nuts; - - stio = stab_io(stab); - if (!stio || !stio->ifp) - goto nuts; - - how = (int)str_gnum(st[++sp]); - return shutdown(fileno(stio->ifp), how) >= 0; - -nuts: - if (dowarn) - warn("shutdown() on closed fd"); - errno = EBADF; - return FALSE; - -} - diff --git a/do/slice b/do/slice deleted file mode 100644 index a55a69e122..0000000000 --- a/do/slice +++ /dev/null @@ -1,96 +0,0 @@ -int -do_slice(stab,TARG,numarray,lval,gimme,arglast) -STAB *stab; -STR *TARG; -int numarray; -int lval; -int gimme; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int max = arglast[2]; - register char *tmps; - register int len; - register int magic = 0; - register ARRAY *ary; - register HASH *hash; - int oldarybase = arybase; - - if (numarray) { - if (numarray == 2) { /* a slice of a LIST */ - ary = stack; - ary->ary_fill = arglast[3]; - arybase -= max + 1; - st[sp] = TARG; /* make stack size available */ - str_numset(TARG,(double)(sp - 1)); - } - else - ary = stab_array(stab); /* a slice of an array */ - } - else { - if (lval) { - if (stab == envstab) - magic = 'E'; - else if (stab == sigstab) - magic = 'S'; -#ifdef SOME_DBM - else if (stab_hash(stab)->tbl_dbm) - magic = 'D'; -#endif /* SOME_DBM */ - } - hash = stab_hash(stab); /* a slice of an associative array */ - } - - if (gimme == G_ARRAY) { - if (numarray) { - while (sp < max) { - if (st[++sp]) { - st[sp-1] = afetch(ary, - ((int)str_gnum(st[sp])) - arybase, lval); - } - else - st[sp-1] = &str_undef; - } - } - else { - while (sp < max) { - if (st[++sp]) { - tmps = str_get(st[sp]); - len = st[sp]->str_cur; - st[sp-1] = hfetch(hash,tmps,len, lval); - if (magic) - str_magic(st[sp-1],stab,magic,tmps,len); - } - else - st[sp-1] = &str_undef; - } - } - sp--; - } - else { - if (sp == max) - st[sp] = &str_undef; - else if (numarray) { - if (st[max]) - st[sp] = afetch(ary, - ((int)str_gnum(st[max])) - arybase, lval); - else - st[sp] = &str_undef; - } - else { - if (st[max]) { - tmps = str_get(st[max]); - len = st[max]->str_cur; - st[sp] = hfetch(hash,tmps,len, lval); - if (magic) - str_magic(st[sp],stab,magic,tmps,len); - } - else - st[sp] = &str_undef; - } - } - arybase = oldarybase; - return sp; -} - diff --git a/do/socket b/do/socket deleted file mode 100644 index 08daa88d0c..0000000000 --- a/do/socket +++ /dev/null @@ -1,42 +0,0 @@ -#ifdef HAS_SOCKET -int -do_socket(stab, arglast) -STAB *stab; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register STIO *stio; - int domain, type, protocol, fd; - - if (!stab) { - errno = EBADF; - return FALSE; - } - - stio = stab_io(stab); - if (!stio) - stio = stab_io(stab) = stio_new(); - else if (stio->ifp) - do_close(stab,FALSE); - - domain = (int)str_gnum(st[++sp]); - type = (int)str_gnum(st[++sp]); - protocol = (int)str_gnum(st[++sp]); - TAINT_PROPER("socket"); - fd = socket(domain,type,protocol); - if (fd < 0) - return FALSE; - stio->ifp = fdopen(fd, "r"); /* stdio gets confused about sockets */ - stio->ofp = fdopen(fd, "w"); - stio->type = 's'; - if (!stio->ifp || !stio->ofp) { - if (stio->ifp) fclose(stio->ifp); - if (stio->ofp) fclose(stio->ofp); - if (!stio->ifp && !stio->ofp) close(fd); - return FALSE; - } - - return TRUE; -} - diff --git a/do/sopt b/do/sopt deleted file mode 100644 index 439f3e2b5d..0000000000 --- a/do/sopt +++ /dev/null @@ -1,51 +0,0 @@ -int -do_sopt(optype, stab, arglast) -int optype; -STAB *stab; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register STIO *stio; - int fd; - unsigned int lvl; - unsigned int optname; - - if (!stab) - goto nuts; - - stio = stab_io(stab); - if (!stio || !stio->ifp) - goto nuts; - - fd = fileno(stio->ifp); - lvl = (unsigned int)str_gnum(st[sp+1]); - optname = (unsigned int)str_gnum(st[sp+2]); - switch (optype) { - case O_GSOCKOPT: - st[sp] = str_2mortal(Str_new(22,257)); - st[sp]->str_cur = 256; - st[sp]->str_pok = 1; - if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, - (int*)&st[sp]->str_cur) < 0) - goto nuts; - break; - case O_SSOCKOPT: - st[sp] = st[sp+3]; - if (setsockopt(fd, lvl, optname, st[sp]->str_ptr, st[sp]->str_cur) < 0) - goto nuts; - st[sp] = &str_yes; - break; - } - - return sp; - -nuts: - if (dowarn) - warn("[gs]etsockopt() on closed fd"); - st[sp] = &str_undef; - errno = EBADF; - return sp; - -} - diff --git a/do/sort b/do/sort deleted file mode 100644 index e98981c661..0000000000 --- a/do/sort +++ /dev/null @@ -1,102 +0,0 @@ -int -do_sort(TARG,arg,gimme,arglast) -STR *TARG; -ARG *arg; -int gimme; -int *arglast; -{ - register STR **st = stack->ary_array; - int sp = arglast[1]; - register STR **up; - register int max = arglast[2] - sp; - register int i; - int sortcmp(); - int sortsub(); - STR *oldfirst; - STR *oldsecond; - ARRAY *oldstack; - HASH *stash; - STR *sortsubvar; - - if (gimme != G_ARRAY) { - str_sset(TARG,&str_undef); - STABSET(TARG); - st[sp] = TARG; - return sp; - } - up = &st[sp]; - sortsubvar = *up; - st += sp; /* temporarily make st point to args */ - for (i = 1; i <= max; i++) { - /*SUPPRESS 560*/ - if (*up = st[i]) { - if (!(*up)->str_pok) - (void)str_2ptr(*up); - else - (*up)->str_pok &= ~SP_TEMP; - up++; - } - } - st -= sp; - max = up - &st[sp]; - sp--; - if (max > 1) { - STAB *stab; - - if (arg[1].arg_type == (A_CMD|A_DONT)) { - sortcmd = arg[1].arg_ptr.arg_cmd; - stash = curcmd->c_stash; - } - else { - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(sortsubvar),TRUE); - - if (stab) { - if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd)) - fatal("Undefined subroutine \"%s\" in sort", - stab_ename(stab)); - stash = stab_estash(stab); - } - else - sortcmd = Nullcmd; - } - - if (sortcmd) { - int oldtmps_base = tmps_base; - - if (!sortstack) { - sortstack = anew(Nullstab); - astore(sortstack, 0, Nullstr); - aclear(sortstack); - sortstack->ary_flags = 0; - } - oldstack = stack; - stack = sortstack; - tmps_base = tmps_max; - if (sortstash != stash) { - firststab = stabent("a",TRUE); - secondstab = stabent("b",TRUE); - sortstash = stash; - } - oldfirst = stab_val(firststab); - oldsecond = stab_val(secondstab); -#ifndef lint - qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub); -#else - qsort(Nullch,max,sizeof(STR*),sortsub); -#endif - stab_val(firststab) = oldfirst; - stab_val(secondstab) = oldsecond; - tmps_base = oldtmps_base; - stack = oldstack; - } -#ifndef lint - else - qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp); -#endif - } - return sp+max; -} - diff --git a/do/spair b/do/spair deleted file mode 100644 index a32479f8de..0000000000 --- a/do/spair +++ /dev/null @@ -1,56 +0,0 @@ -#ifdef HAS_SOCKET -int -do_spair(stab1, stab2, arglast) -STAB *stab1; -STAB *stab2; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[2]; - register STIO *stio1; - register STIO *stio2; - int domain, type, protocol, fd[2]; - - if (!stab1 || !stab2) - return FALSE; - - stio1 = stab_io(stab1); - stio2 = stab_io(stab2); - if (!stio1) - stio1 = stab_io(stab1) = stio_new(); - else if (stio1->ifp) - do_close(stab1,FALSE); - if (!stio2) - stio2 = stab_io(stab2) = stio_new(); - else if (stio2->ifp) - do_close(stab2,FALSE); - - domain = (int)str_gnum(st[++sp]); - type = (int)str_gnum(st[++sp]); - protocol = (int)str_gnum(st[++sp]); -TAINT_PROPER("in socketpair"); -#ifdef HAS_SOCKETPAIR - if (socketpair(domain,type,protocol,fd) < 0) - return FALSE; -#else - fatal("Socketpair unimplemented"); -#endif - stio1->ifp = fdopen(fd[0], "r"); - stio1->ofp = fdopen(fd[0], "w"); - stio1->type = 's'; - stio2->ifp = fdopen(fd[1], "r"); - stio2->ofp = fdopen(fd[1], "w"); - stio2->type = 's'; - if (!stio1->ifp || !stio1->ofp || !stio2->ifp || !stio2->ofp) { - if (stio1->ifp) fclose(stio1->ifp); - if (stio1->ofp) fclose(stio1->ofp); - if (!stio1->ifp && !stio1->ofp) close(fd[0]); - if (stio2->ifp) fclose(stio2->ifp); - if (stio2->ofp) fclose(stio2->ofp); - if (!stio2->ifp && !stio2->ofp) close(fd[1]); - return FALSE; - } - - return TRUE; -} - diff --git a/do/splice b/do/splice deleted file mode 100644 index 58aa56c8bf..0000000000 --- a/do/splice +++ /dev/null @@ -1,192 +0,0 @@ -int -do_splice(ary,gimme,arglast) -register ARRAY *ary; -int gimme; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - int max = arglast[2] + 1; - register STR **src; - register STR **dst; - register int i; - register int offset; - register int length; - int newlen; - int after; - int diff; - STR **tmparyval; - - if (++sp < max) { - offset = (int)str_gnum(st[sp]); - if (offset < 0) - offset += ary->ary_fill + 1; - else - offset -= arybase; - if (++sp < max) { - length = (int)str_gnum(st[sp++]); - if (length < 0) - length = 0; - } - else - length = ary->ary_max + 1; /* close enough to infinity */ - } - else { - offset = 0; - length = ary->ary_max + 1; - } - if (offset < 0) { - length += offset; - offset = 0; - if (length < 0) - length = 0; - } - if (offset > ary->ary_fill + 1) - offset = ary->ary_fill + 1; - after = ary->ary_fill + 1 - (offset + length); - if (after < 0) { /* not that much array */ - length += after; /* offset+length now in array */ - after = 0; - if (!ary->ary_alloc) { - afill(ary,0); - afill(ary,-1); - } - } - - /* At this point, sp .. max-1 is our new LIST */ - - newlen = max - sp; - diff = newlen - length; - - if (diff < 0) { /* shrinking the area */ - if (newlen) { - New(451, tmparyval, newlen, STR*); /* so remember insertion */ - Copy(st+sp, tmparyval, newlen, STR*); - } - - sp = arglast[0] + 1; - if (gimme == G_ARRAY) { /* copy return vals to stack */ - if (sp + length >= stack->ary_max) { - astore(stack,sp + length, Nullstr); - st = stack->ary_array; - } - Copy(ary->ary_array+offset, st+sp, length, STR*); - if (ary->ary_flags & ARF_REAL) { - for (i = length, dst = st+sp; i; i--) - str_2mortal(*dst++); /* free them eventualy */ - } - sp += length - 1; - } - else { - st[sp] = ary->ary_array[offset+length-1]; - if (ary->ary_flags & ARF_REAL) { - str_2mortal(st[sp]); - for (i = length - 1, dst = &ary->ary_array[offset]; i > 0; i--) - str_free(*dst++); /* free them now */ - } - } - ary->ary_fill += diff; - - /* pull up or down? */ - - if (offset < after) { /* easier to pull up */ - if (offset) { /* esp. if nothing to pull */ - src = &ary->ary_array[offset-1]; - dst = src - diff; /* diff is negative */ - for (i = offset; i > 0; i--) /* can't trust Copy */ - *dst-- = *src--; - } - Zero(ary->ary_array, -diff, STR*); - ary->ary_array -= diff; /* diff is negative */ - ary->ary_max += diff; - } - else { - if (after) { /* anything to pull down? */ - src = ary->ary_array + offset + length; - dst = src + diff; /* diff is negative */ - Move(src, dst, after, STR*); - } - Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*); - /* avoid later double free */ - } - if (newlen) { - for (src = tmparyval, dst = ary->ary_array + offset; - newlen; newlen--) { - *dst = Str_new(46,0); - str_sset(*dst++,*src++); - } - Safefree(tmparyval); - } - } - else { /* no, expanding (or same) */ - if (length) { - New(452, tmparyval, length, STR*); /* so remember deletion */ - Copy(ary->ary_array+offset, tmparyval, length, STR*); - } - - if (diff > 0) { /* expanding */ - - /* push up or down? */ - - if (offset < after && diff <= ary->ary_array - ary->ary_alloc) { - if (offset) { - src = ary->ary_array; - dst = src - diff; - Move(src, dst, offset, STR*); - } - ary->ary_array -= diff; /* diff is positive */ - ary->ary_max += diff; - ary->ary_fill += diff; - } - else { - if (ary->ary_fill + diff >= ary->ary_max) /* oh, well */ - astore(ary, ary->ary_fill + diff, Nullstr); - else - ary->ary_fill += diff; - dst = ary->ary_array + ary->ary_fill; - for (i = diff; i > 0; i--) { - if (*dst) /* TARG was hanging around */ - str_free(*dst); /* after $#foo */ - dst--; - } - if (after) { - dst = ary->ary_array + ary->ary_fill; - src = dst - diff; - for (i = after; i; i--) { - *dst-- = *src--; - } - } - } - } - - for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) { - *dst = Str_new(46,0); - str_sset(*dst++,*src++); - } - sp = arglast[0] + 1; - if (gimme == G_ARRAY) { /* copy return vals to stack */ - if (length) { - Copy(tmparyval, st+sp, length, STR*); - if (ary->ary_flags & ARF_REAL) { - for (i = length, dst = st+sp; i; i--) - str_2mortal(*dst++); /* free them eventualy */ - } - Safefree(tmparyval); - } - sp += length - 1; - } - else if (length--) { - st[sp] = tmparyval[length]; - if (ary->ary_flags & ARF_REAL) { - str_2mortal(st[sp]); - while (length-- > 0) - str_free(tmparyval[length]); - } - Safefree(tmparyval); - } - else - st[sp] = &str_undef; - } - return sp; -} - diff --git a/do/split b/do/split deleted file mode 100644 index 904d29ae72..0000000000 --- a/do/split +++ /dev/null @@ -1,235 +0,0 @@ -int -do_split(TARG,spat,limit,gimme,arglast) -STR *TARG; -register SPAT *spat; -register int limit; -int gimme; -int *arglast; -{ - register ARRAY *ary = stack; - STR **st = ary->ary_array; - register int sp = arglast[0] + 1; - register char *s = str_get(st[sp]); - char *strend = s + st[sp--]->str_cur; - register STR *dstr; - register char *m; - int iters = 0; - int maxiters = (strend - s) + 10; - int i; - char *orig; - int origlimit = limit; - int realarray = 0; - - if (!spat || !s) - fatal("panic: do_split"); - else if (spat->spat_runtime) { - nointrp = "|)"; - sp = eval(spat->spat_runtime,G_SCALAR,sp); - st = stack->ary_array; - m = str_get(dstr = st[sp--]); - nointrp = ""; - if (*m == ' ' && dstr->str_cur == 1) { - str_set(dstr,"\\s+"); - m = dstr->str_ptr; - spat->spat_flags |= SPAT_SKIPWHITE; - } - if (spat->spat_regexp) { - regfree(spat->spat_regexp); - spat->spat_regexp = Null(REGEXP*); /* avoid possible double free */ - } - spat->spat_regexp = regcomp(m,m+dstr->str_cur, - spat->spat_flags & SPAT_FOLD); - if (spat->spat_flags & SPAT_KEEP || - (spat->spat_runtime->arg_type == O_ITEM && - (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) { - arg_free(spat->spat_runtime); /* it won't change, so */ - spat->spat_runtime = Nullarg; /* no point compiling again */ - } - } -#ifdef DEBUGGING - if (debug & 8) { - deb("2.SPAT /%s/\n",spat->spat_regexp->precomp); - } -#endif - ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab); - if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) { - realarray = 1; - if (!(ary->ary_flags & ARF_REAL)) { - ary->ary_flags |= ARF_REAL; - for (i = ary->ary_fill; i >= 0; i--) - ary->ary_array[i] = Nullstr; /* don't free mere refs */ - } - ary->ary_fill = -1; - sp = -1; /* temporarily switch stacks */ - } - else - ary = stack; - orig = s; - if (spat->spat_flags & SPAT_SKIPWHITE) { - while (isSPACE(*s)) - s++; - } - if (!limit) - limit = maxiters + 2; - if (strEQ("\\s+",spat->spat_regexp->precomp)) { - while (--limit) { - /*SUPPRESS 530*/ - for (m = s; m < strend && !isSPACE(*m); m++) ; - if (m >= strend) - break; - dstr = Str_new(30,m-s); - str_nset(dstr,s,m-s); - if (!realarray) - str_2mortal(dstr); - (void)astore(ary, ++sp, dstr); - /*SUPPRESS 530*/ - for (s = m + 1; s < strend && isSPACE(*s); s++) ; - } - } - else if (strEQ("^",spat->spat_regexp->precomp)) { - while (--limit) { - /*SUPPRESS 530*/ - for (m = s; m < strend && *m != '\n'; m++) ; - m++; - if (m >= strend) - break; - dstr = Str_new(30,m-s); - str_nset(dstr,s,m-s); - if (!realarray) - str_2mortal(dstr); - (void)astore(ary, ++sp, dstr); - s = m; - } - } - else if (spat->spat_short) { - i = spat->spat_short->str_cur; - if (i == 1) { - int fold = (spat->spat_flags & SPAT_FOLD); - - i = *spat->spat_short->str_ptr; - if (fold && isUPPER(i)) - i = tolower(i); - while (--limit) { - if (fold) { - for ( m = s; - m < strend && *m != i && - (!isUPPER(*m) || tolower(*m) != i); - m++) /*SUPPRESS 530*/ - ; - } - else /*SUPPRESS 530*/ - for (m = s; m < strend && *m != i; m++) ; - if (m >= strend) - break; - dstr = Str_new(30,m-s); - str_nset(dstr,s,m-s); - if (!realarray) - str_2mortal(dstr); - (void)astore(ary, ++sp, dstr); - s = m + 1; - } - } - else { -#ifndef lint - while (s < strend && --limit && - (m=fbminstr((unsigned char*)s, (unsigned char*)strend, - spat->spat_short)) ) -#endif - { - dstr = Str_new(31,m-s); - str_nset(dstr,s,m-s); - if (!realarray) - str_2mortal(dstr); - (void)astore(ary, ++sp, dstr); - s = m + i; - } - } - } - else { - maxiters += (strend - s) * spat->spat_regexp->nparens; - while (s < strend && --limit && - regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) { - if (spat->spat_regexp->subbase - && spat->spat_regexp->subbase != orig) { - m = s; - s = orig; - orig = spat->spat_regexp->subbase; - s = orig + (m - s); - strend = s + (strend - m); - } - m = spat->spat_regexp->startp[0]; - dstr = Str_new(32,m-s); - str_nset(dstr,s,m-s); - if (!realarray) - str_2mortal(dstr); - (void)astore(ary, ++sp, dstr); - if (spat->spat_regexp->nparens) { - for (i = 1; i <= spat->spat_regexp->nparens; i++) { - s = spat->spat_regexp->startp[i]; - m = spat->spat_regexp->endp[i]; - dstr = Str_new(33,m-s); - str_nset(dstr,s,m-s); - if (!realarray) - str_2mortal(dstr); - (void)astore(ary, ++sp, dstr); - } - } - s = spat->spat_regexp->endp[0]; - } - } - if (realarray) - iters = sp + 1; - else - iters = sp - arglast[0]; - if (iters > maxiters) - fatal("Split loop"); - if (s < strend || origlimit) { /* keep field after final delim? */ - dstr = Str_new(34,strend-s); - str_nset(dstr,s,strend-s); - if (!realarray) - str_2mortal(dstr); - (void)astore(ary, ++sp, dstr); - iters++; - } - else { -#ifndef I286x - while (iters > 0 && ary->ary_array[sp]->str_cur == 0) - iters--,sp--; -#else - char *zaps; - int zapb; - - if (iters > 0) { - zaps = str_get(afetch(ary,sp,FALSE)); - zapb = (int) *zaps; - } - - while (iters > 0 && (!zapb)) { - iters--,sp--; - if (iters > 0) { - zaps = str_get(afetch(ary,iters-1,FALSE)); - zapb = (int) *zaps; - } - } -#endif - } - if (realarray) { - ary->ary_fill = sp; - if (gimme == G_ARRAY) { - sp++; - astore(stack, arglast[0] + 1 + sp, Nullstr); - Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*); - return arglast[0] + sp; - } - } - else { - if (gimme == G_ARRAY) - return sp; - } - sp = arglast[0] + 1; - str_numset(TARG,(double)iters); - STABSET(TARG); - st[sp] = TARG; - return sp; -} - diff --git a/do/sprintf b/do/sprintf deleted file mode 100644 index c4b9d9caad..0000000000 --- a/do/sprintf +++ /dev/null @@ -1,197 +0,0 @@ -void -do_sprintf(TARG,len,sarg) -register STR *TARG; -register int len; -register STR **sarg; -{ - register char *s; - register char *t; - register char *f; - bool dolong; -#ifdef QUAD - bool doquad; -#endif /* QUAD */ - char ch; - register char *send; - register STR *arg; - char *xs; - int xlen; - int pre; - int post; - double value; - - str_set(TARG,""); - len--; /* don't count pattern string */ - t = s = str_get(*sarg); - send = s + (*sarg)->str_cur; - sarg++; - for ( ; ; len--) { - - /*SUPPRESS 560*/ - if (len <= 0 || !(arg = *sarg++)) - arg = &str_no; - - /*SUPPRESS 530*/ - for ( ; t < send && *t != '%'; t++) ; - if (t >= send) - break; /* end of format string, ignore extra args */ - f = t; - *buf = '\0'; - xs = buf; -#ifdef QUAD - doquad = -#endif /* QUAD */ - dolong = FALSE; - pre = post = 0; - for (t++; t < send; t++) { - switch (*t) { - default: - ch = *(++t); - *t = '\0'; - (void)sprintf(xs,f); - len++, sarg--; - xlen = strlen(xs); - break; - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - case '.': case '#': case '-': case '+': case ' ': - continue; - case 'l': -#ifdef QUAD - if (dolong) { - dolong = FALSE; - doquad = TRUE; - } else -#endif - dolong = TRUE; - continue; - case 'c': - ch = *(++t); - *t = '\0'; - xlen = (int)str_gnum(arg); - if (strEQ(f,"%c")) { /* some printfs fail on null chars */ - *xs = xlen; - xs[1] = '\0'; - xlen = 1; - } - else { - (void)sprintf(xs,f,xlen); - xlen = strlen(xs); - } - break; - case 'D': - dolong = TRUE; - /* FALL THROUGH */ - case 'd': - ch = *(++t); - *t = '\0'; -#ifdef QUAD - if (doquad) - (void)sprintf(buf,s,(quad)str_gnum(arg)); - else -#endif - if (dolong) - (void)sprintf(xs,f,(long)str_gnum(arg)); - else - (void)sprintf(xs,f,(int)str_gnum(arg)); - xlen = strlen(xs); - break; - case 'X': case 'O': - dolong = TRUE; - /* FALL THROUGH */ - case 'x': case 'o': case 'u': - ch = *(++t); - *t = '\0'; - value = str_gnum(arg); -#ifdef QUAD - if (doquad) - (void)sprintf(buf,s,(unsigned quad)value); - else -#endif - if (dolong) - (void)sprintf(xs,f,U_L(value)); - else - (void)sprintf(xs,f,U_I(value)); - xlen = strlen(xs); - break; - case 'E': case 'e': case 'f': case 'G': case 'g': - ch = *(++t); - *t = '\0'; - (void)sprintf(xs,f,str_gnum(arg)); - xlen = strlen(xs); - break; - case 's': - ch = *(++t); - *t = '\0'; - xs = str_get(arg); - xlen = arg->str_cur; - if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0' - && xlen == sizeof(STBP)) { - STR *tmpstr = Str_new(24,0); - - stab_efullname(tmpstr, ((STAB*)arg)); /* a stab value! */ - sprintf(tokenbuf,"*%s",tmpstr->str_ptr); - /* reformat to non-binary */ - xs = tokenbuf; - xlen = strlen(tokenbuf); - str_free(tmpstr); - } - if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */ - break; /* so handle simple cases */ - } - else if (f[1] == '-') { - char *mp = index(f, '.'); - int min = atoi(f+2); - - if (mp) { - int max = atoi(mp+1); - - if (xlen > max) - xlen = max; - } - if (xlen < min) - post = min - xlen; - break; - } - else if (isDIGIT(f[1])) { - char *mp = index(f, '.'); - int min = atoi(f+1); - - if (mp) { - int max = atoi(mp+1); - - if (xlen > max) - xlen = max; - } - if (xlen < min) - pre = min - xlen; - break; - } - strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */ - *t = ch; - (void)sprintf(buf,tokenbuf+64,xs); - xs = buf; - xlen = strlen(xs); - break; - } - /* end of switch, copy results */ - *t = ch; - STR_GROW(TARG, TARG->str_cur + (f - s) + xlen + 1 + pre + post); - str_ncat(TARG, s, f - s); - if (pre) { - repeatcpy(TARG->str_ptr + TARG->str_cur, " ", 1, pre); - TARG->str_cur += pre; - } - str_ncat(TARG, xs, xlen); - if (post) { - repeatcpy(TARG->str_ptr + TARG->str_cur, " ", 1, post); - TARG->str_cur += post; - } - s = t; - break; /* break from for loop */ - } - } - str_ncat(TARG, s, t - s); - STABSET(TARG); -} - diff --git a/do/sreverse b/do/sreverse deleted file mode 100644 index bbf88b723d..0000000000 --- a/do/sreverse +++ /dev/null @@ -1,25 +0,0 @@ -int -do_sreverse(TARG,arglast) -STR *TARG; -int *arglast; -{ - STR **st = stack->ary_array; - register char *up; - register char *down; - register int tmp; - - str_sset(TARG,st[arglast[2]]); - up = str_get(TARG); - if (TARG->str_cur > 1) { - down = TARG->str_ptr + TARG->str_cur - 1; - while (down > up) { - tmp = *up; - *up++ = *down; - *down-- = tmp; - } - } - STABSET(TARG); - st[arglast[0]+1] = TARG; - return arglast[0]+1; -} - diff --git a/do/stat b/do/stat deleted file mode 100644 index d53f0ecc1d..0000000000 --- a/do/stat +++ /dev/null @@ -1,95 +0,0 @@ -int -do_stat(TARG,arg,gimme,arglast) -STR *TARG; -register ARG *arg; -int gimme; -int *arglast; -{ - register ARRAY *ary = stack; - register int sp = arglast[0] + 1; - int max = 13; - - if ((arg[1].arg_type & A_MASK) == A_WORD) { - tmpstab = arg[1].arg_ptr.arg_stab; - if (tmpstab != defstab) { - laststype = O_STAT; - statstab = tmpstab; - str_set(statname,""); - if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp || - fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) { - max = 0; - laststatval = -1; - } - } - else if (laststatval < 0) - max = 0; - } - else { - str_set(statname,str_get(ary->ary_array[sp])); - statstab = Nullstab; -#ifdef HAS_LSTAT - laststype = arg->arg_type; - if (arg->arg_type == O_LSTAT) - laststatval = lstat(str_get(statname),&statcache); - else -#endif - laststatval = stat(str_get(statname),&statcache); - if (laststatval < 0) { - if (dowarn && index(str_get(statname), '\n')) - warn(warn_nl, "stat"); - max = 0; - } - } - - if (gimme != G_ARRAY) { - if (max) - str_sset(TARG,&str_yes); - else - str_sset(TARG,&str_undef); - STABSET(TARG); - ary->ary_array[sp] = TARG; - return sp; - } - sp--; - if (max) { -#ifndef lint - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_dev))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_ino))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_mode))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_nlink))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_uid))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_gid))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_rdev))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_size))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_atime))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_mtime))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_ctime))); -#ifdef STATBLOCKS - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_blksize))); - (void)astore(ary,++sp, - str_2mortal(str_nmake((double)statcache.st_blocks))); -#else - (void)astore(ary,++sp, - str_2mortal(str_make("",0))); - (void)astore(ary,++sp, - str_2mortal(str_make("",0))); -#endif -#else /* lint */ - (void)astore(ary,++sp,str_nmake(0.0)); -#endif /* lint */ - } - return sp; -} - diff --git a/do/study b/do/study deleted file mode 100644 index 14c2e067c0..0000000000 --- a/do/study +++ /dev/null @@ -1,73 +0,0 @@ -int /*SUPPRESS 590*/ -do_study(TARG,arg,gimme,arglast) -STR *TARG; -ARG *arg; -int gimme; -int *arglast; -{ - register unsigned char *s; - register int pos = TARG->str_cur; - register int ch; - register int *sfirst; - register int *snext; - int retval; - int retarg = arglast[0] + 1; - -#ifndef lint - s = (unsigned char*)(str_get(TARG)); -#else - s = Null(unsigned char*); -#endif - if (lastscream) - lastscream->str_pok &= ~SP_STUDIED; - lastscream = TARG; - if (pos <= 0) { - retval = 0; - goto ret; - } - if (pos > maxscream) { - if (maxscream < 0) { - maxscream = pos + 80; - New(301,screamfirst, 256, int); - New(302,screamnext, maxscream, int); - } - else { - maxscream = pos + pos / 4; - Renew(screamnext, maxscream, int); - } - } - - sfirst = screamfirst; - snext = screamnext; - - if (!sfirst || !snext) - fatal("do_study: out of memory"); - - for (ch = 256; ch; --ch) - *sfirst++ = -1; - sfirst -= 256; - - while (--pos >= 0) { - ch = s[pos]; - if (sfirst[ch] >= 0) - snext[pos] = sfirst[ch] - pos; - else - snext[pos] = -pos; - sfirst[ch] = pos; - - /* If there were any case insensitive searches, we must assume they - * all are. This speeds up insensitive searches much more than - * it slows down sensitive ones. - */ - if (sawi) - sfirst[fold[ch]] = pos; - } - - TARG->str_pok |= SP_STUDIED; - retval = 1; - ret: - str_numset(ARGTARG,(double)retval); - stack->ary_array[retarg] = ARGTARG; - return retarg; -} - diff --git a/do/subr b/do/subr deleted file mode 100644 index 076fe9664e..0000000000 --- a/do/subr +++ /dev/null @@ -1,91 +0,0 @@ -int -do_subr(arg,gimme,arglast) -register ARG *arg; -int gimme; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int items = arglast[2] - sp; - register SUBR *sub; - SPAT * VOL oldspat = curspat; - STR *TARG; - STAB *stab; - int oldsave = savestack->ary_fill; - int oldtmps_base = tmps_base; - int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL); - register CSV *csv; - - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else { - STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab); - - if (tmpstr) - stab = stabent(str_get(tmpstr),TRUE); - else - stab = Nullstab; - } - if (!stab) - fatal("Undefined subroutine called"); - if (!(sub = stab_sub(stab))) { - STR *tmpstr = arg[0].arg_ptr.arg_str; - - stab_efullname(tmpstr, stab); - fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr); - } - if (arg->arg_type == O_DBSUBR && !sub->usersub) { - TARG = stab_val(DBsub); - saveitem(TARG); - stab_efullname(TARG,stab); - sub = stab_sub(DBsub); - if (!sub) - fatal("No DBsub routine"); - } - TARG = Str_new(15, sizeof(CSV)); - TARG->str_state = SS_SCSV; - (void)apush(savestack,TARG); - csv = (CSV*)TARG->str_ptr; - csv->sub = sub; - csv->stab = stab; - csv->oldcsv = curcsv; - csv->oldcmd = curcmd; - csv->depth = sub->depth; - csv->wantarray = gimme; - csv->hasargs = hasargs; - curcsv = csv; - tmps_base = tmps_max; - if (sub->usersub) { - csv->hasargs = 0; - csv->savearray = Null(ARRAY*);; - csv->argarray = Null(ARRAY*); - st[sp] = ARGTARG; - if (!hasargs) - items = 0; - sp = (*sub->usersub)(sub->userindex,sp,items); - } - else { - if (hasargs) { - csv->savearray = stab_xarray(defstab); - csv->argarray = afake(defstab, items, &st[sp+1]); - stab_xarray(defstab) = csv->argarray; - } - sub->depth++; - if (sub->depth >= 2) { /* save temporaries on recursion? */ - if (sub->depth == 100 && dowarn) - warn("Deep recursion on subroutine \"%s\"",stab_ename(stab)); - savelist(sub->tosave->ary_array,sub->tosave->ary_fill); - } - sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */ - } - - st = stack->ary_array; - tmps_base = oldtmps_base; - for (items = arglast[0] + 1; items <= sp; items++) - st[items] = str_mortal(st[items]); - /* in case restore wipes old TARG */ - restorelist(oldsave); - curspat = oldspat; - return sp; -} - diff --git a/do/subst b/do/subst deleted file mode 100644 index 77dbde18c5..0000000000 --- a/do/subst +++ /dev/null @@ -1,269 +0,0 @@ -int -do_subst(TARG,arg,sp) -STR *TARG; -ARG *arg; -int sp; -{ - register SPAT *spat; - SPAT *rspat; - register STR *dstr; - register char *s = str_get(TARG); - char *strend = s + TARG->str_cur; - register char *m; - char *c; - register char *d; - int clen; - int iters = 0; - int maxiters = (strend - s) + 10; - register int i; - bool once; - char *orig; - int safebase; - - rspat = spat = arg[2].arg_ptr.arg_spat; - if (!spat || !s) - fatal("panic: do_subst"); - else if (spat->spat_runtime) { - nointrp = "|)"; - (void)eval(spat->spat_runtime,G_SCALAR,sp); - m = str_get(dstr = stack->ary_array[sp+1]); - nointrp = ""; - if (spat->spat_regexp) { - regfree(spat->spat_regexp); - spat->spat_regexp = Null(REGEXP*); /* required if regcomp pukes */ - } - spat->spat_regexp = regcomp(m,m+dstr->str_cur, - spat->spat_flags & SPAT_FOLD); - if (spat->spat_flags & SPAT_KEEP) { - if (!(spat->spat_flags & SPAT_FOLD)) - scanconst(spat, m, dstr->str_cur); - arg_free(spat->spat_runtime); /* it won't change, so */ - spat->spat_runtime = Nullarg; /* no point compiling again */ - hoistmust(spat); - if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) { - curcmd->c_flags &= ~CF_OPTIMIZE; - opt_arg(curcmd, 1, curcmd->c_type == C_EXPR); - } - } - } -#ifdef DEBUGGING - if (debug & 8) { - deb("2.SPAT /%s/\n",spat->spat_regexp->precomp); - } -#endif - safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) && - !sawampersand); - if (!spat->spat_regexp->prelen && lastspat) - spat = lastspat; - orig = m = s; - if (hint) { - if (hint < s || hint > strend) - fatal("panic: hint in do_match"); - s = hint; - hint = Nullch; - if (spat->spat_regexp->regback >= 0) { - s -= spat->spat_regexp->regback; - if (s < m) - s = m; - } - else - s = m; - } - else if (spat->spat_short) { - if (spat->spat_flags & SPAT_SCANFIRST) { - if (TARG->str_pok & SP_STUDIED) { - if (screamfirst[spat->spat_short->str_rare] < 0) - goto nope; - else if (!(s = screaminstr(TARG,spat->spat_short))) - goto nope; - } -#ifndef lint - else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend, - spat->spat_short))) - goto nope; -#endif - if (s && spat->spat_regexp->regback >= 0) { - ++spat->spat_short->str_u.str_useful; - s -= spat->spat_regexp->regback; - if (s < m) - s = m; - } - else - s = m; - } - else if (!multiline && (*spat->spat_short->str_ptr != *s || - bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) )) - goto nope; - if (--spat->spat_short->str_u.str_useful < 0) { - str_free(spat->spat_short); - spat->spat_short = Nullstr; /* opt is being useless */ - } - } - once = !(rspat->spat_flags & SPAT_GLOBAL); - if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */ - if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE) - dstr = rspat->spat_repl[1].arg_ptr.arg_str; - else { /* constant over loop, anyway */ - (void)eval(rspat->spat_repl,G_SCALAR,sp); - dstr = stack->ary_array[sp+1]; - } - c = str_get(dstr); - clen = dstr->str_cur; - if (clen <= spat->spat_regexp->minlen) { - /* can do inplace substitution */ - if (regexec(spat->spat_regexp, s, strend, orig, 0, - TARG->str_pok & SP_STUDIED ? TARG : Nullstr, safebase)) { - if (spat->spat_regexp->subbase) /* oops, no we can't */ - goto long_way; - d = s; - lastspat = spat; - TARG->str_pok = SP_VALID; /* disable possible screamer */ - if (once) { - m = spat->spat_regexp->startp[0]; - d = spat->spat_regexp->endp[0]; - s = orig; - if (m - s > strend - d) { /* faster to shorten from end */ - if (clen) { - Copy(c, m, clen, char); - m += clen; - } - i = strend - d; - if (i > 0) { - Move(d, m, i, char); - m += i; - } - *m = '\0'; - TARG->str_cur = m - s; - STABSET(TARG); - str_numset(ARGTARG, 1.0); - stack->ary_array[++sp] = ARGTARG; - return sp; - } - /*SUPPRESS 560*/ - else if (i = m - s) { /* faster from front */ - d -= clen; - m = d; - str_chop(TARG,d-i); - s += i; - while (i--) - *--d = *--s; - if (clen) - Copy(c, m, clen, char); - STABSET(TARG); - str_numset(ARGTARG, 1.0); - stack->ary_array[++sp] = ARGTARG; - return sp; - } - else if (clen) { - d -= clen; - str_chop(TARG,d); - Copy(c,d,clen,char); - STABSET(TARG); - str_numset(ARGTARG, 1.0); - stack->ary_array[++sp] = ARGTARG; - return sp; - } - else { - str_chop(TARG,d); - STABSET(TARG); - str_numset(ARGTARG, 1.0); - stack->ary_array[++sp] = ARGTARG; - return sp; - } - /* NOTREACHED */ - } - do { - if (iters++ > maxiters) - fatal("Substitution loop"); - m = spat->spat_regexp->startp[0]; - /*SUPPRESS 560*/ - if (i = m - s) { - if (s != d) - Move(s,d,i,char); - d += i; - } - if (clen) { - Copy(c,d,clen,char); - d += clen; - } - s = spat->spat_regexp->endp[0]; - } while (regexec(spat->spat_regexp, s, strend, orig, s == m, - Nullstr, TRUE)); /* (don't match same null twice) */ - if (s != d) { - i = strend - s; - TARG->str_cur = d - TARG->str_ptr + i; - Move(s,d,i+1,char); /* include the Null */ - } - STABSET(TARG); - str_numset(ARGTARG, (double)iters); - stack->ary_array[++sp] = ARGTARG; - return sp; - } - str_numset(ARGTARG, 0.0); - stack->ary_array[++sp] = ARGTARG; - return sp; - } - } - else - c = Nullch; - if (regexec(spat->spat_regexp, s, strend, orig, 0, - TARG->str_pok & SP_STUDIED ? TARG : Nullstr, safebase)) { - long_way: - dstr = Str_new(25,str_len(TARG)); - str_nset(dstr,m,s-m); - if (spat->spat_regexp->subbase) - curspat = spat; - lastspat = spat; - do { - if (iters++ > maxiters) - fatal("Substitution loop"); - if (spat->spat_regexp->subbase - && spat->spat_regexp->subbase != orig) { - m = s; - s = orig; - orig = spat->spat_regexp->subbase; - s = orig + (m - s); - strend = s + (strend - m); - } - m = spat->spat_regexp->startp[0]; - str_ncat(dstr,s,m-s); - s = spat->spat_regexp->endp[0]; - if (c) { - if (clen) - str_ncat(dstr,c,clen); - } - else { - char *mysubbase = spat->spat_regexp->subbase; - - spat->spat_regexp->subbase = Nullch; /* so recursion works */ - (void)eval(rspat->spat_repl,G_SCALAR,sp); - str_scat(dstr,stack->ary_array[sp+1]); - if (spat->spat_regexp->subbase) - Safefree(spat->spat_regexp->subbase); - spat->spat_regexp->subbase = mysubbase; - } - if (once) - break; - } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr, - safebase)); - str_ncat(dstr,s,strend - s); - str_replace(TARG,dstr); - STABSET(TARG); - str_numset(ARGTARG, (double)iters); - stack->ary_array[++sp] = ARGTARG; - return sp; - } - str_numset(ARGTARG, 0.0); - stack->ary_array[++sp] = ARGTARG; - return sp; - -nope: - ++spat->spat_short->str_u.str_useful; - str_numset(ARGTARG, 0.0); - stack->ary_array[++sp] = ARGTARG; - return sp; -} -#ifdef BUGGY_MSC - #pragma intrinsic(memcmp) -#endif /* BUGGY_MSC */ - diff --git a/do/syscall b/do/syscall deleted file mode 100644 index 51e65ba65e..0000000000 --- a/do/syscall +++ /dev/null @@ -1,99 +0,0 @@ -int -do_syscall(arglast) -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int items = arglast[2] - sp; -#ifdef atarist - unsigned long arg[14]; /* yes, we really need that many ! */ -#else - unsigned long arg[8]; -#endif - register int i = 0; - int retval = -1; - -#ifdef HAS_SYSCALL -#ifdef TAINT - for (st += ++sp; items--; st++) - tainted |= (*st)->str_tainted; - st = stack->ary_array; - sp = arglast[1]; - items = arglast[2] - sp; -#endif - TAINT_PROPER("syscall"); - /* This probably won't work on machines where sizeof(long) != sizeof(int) - * or where sizeof(long) != sizeof(char*). But such machines will - * not likely have syscall implemented either, so who cares? - */ - while (items--) { - if (st[++sp]->str_nok || !i) - arg[i++] = (unsigned long)str_gnum(st[sp]); -#ifndef lint - else - arg[i++] = (unsigned long)st[sp]->str_ptr; -#endif /* lint */ - } - sp = arglast[1]; - items = arglast[2] - sp; - switch (items) { - case 0: - fatal("Too few args to syscall"); - case 1: - retval = syscall(arg[0]); - break; - case 2: - retval = syscall(arg[0],arg[1]); - break; - case 3: - retval = syscall(arg[0],arg[1],arg[2]); - break; - case 4: - retval = syscall(arg[0],arg[1],arg[2],arg[3]); - break; - case 5: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]); - break; - case 6: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]); - break; - case 7: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]); - break; - case 8: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6], - arg[7]); - break; -#ifdef atarist - case 9: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6], - arg[7], arg[8]); - break; - case 10: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6], - arg[7], arg[8], arg[9]); - break; - case 11: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6], - arg[7], arg[8], arg[9], arg[10]); - break; - case 12: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6], - arg[7], arg[8], arg[9], arg[10], arg[11]); - break; - case 13: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6], - arg[7], arg[8], arg[9], arg[10], arg[11], arg[12]); - break; - case 14: - retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6], - arg[7], arg[8], arg[9], arg[10], arg[11], arg[12], arg[13]); - break; -#endif /* atarist */ - } - return retval; -#else - fatal("syscall() unimplemented"); -#endif -} - diff --git a/do/tell b/do/tell deleted file mode 100644 index 11e6f837db..0000000000 --- a/do/tell +++ /dev/null @@ -1,27 +0,0 @@ -long -do_tell(stab) -STAB *stab; -{ - register STIO *stio; - - if (!stab) - goto phooey; - - stio = stab_io(stab); - if (!stio || !stio->ifp) - goto phooey; - -#ifdef ULTRIX_STDIO_BOTCH - if (feof(stio->ifp)) - (void)fseek (stio->ifp, 0L, 2); /* ultrix 1.2 workaround */ -#endif - - return ftell(stio->ifp); - -phooey: - if (dowarn) - warn("tell() on unopened file"); - errno = EBADF; - return -1L; -} - diff --git a/do/time b/do/time deleted file mode 100644 index dbe45efd34..0000000000 --- a/do/time +++ /dev/null @@ -1,29 +0,0 @@ -int -do_time(TARG,tmbuf,gimme,arglast) -STR *TARG; -struct tm *tmbuf; -int gimme; -int *arglast; -{ - register ARRAY *ary = stack; - STR **st = ary->ary_array; - register int sp = arglast[0]; - - if (!tmbuf || gimme != G_ARRAY) { - str_sset(TARG,&str_undef); - STABSET(TARG); - st[++sp] = TARG; - return sp; - } - (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_sec))); - (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_min))); - (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_hour))); - (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mday))); - (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mon))); - (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_year))); - (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_wday))); - (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_yday))); - (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_isdst))); - return sp; -} - diff --git a/do/tms b/do/tms deleted file mode 100644 index 78ad5269a2..0000000000 --- a/do/tms +++ /dev/null @@ -1,41 +0,0 @@ -int -do_tms(TARG,gimme,arglast) -STR *TARG; -int gimme; -int *arglast; -{ -#ifdef MSDOS - return -1; -#else - STR **st = stack->ary_array; - register int sp = arglast[0]; - - if (gimme != G_ARRAY) { - str_sset(TARG,&str_undef); - STABSET(TARG); - st[++sp] = TARG; - return sp; - } - (void)times(×buf); - -#ifndef HZ -#define HZ 60 -#endif - -#ifndef lint - (void)astore(stack,++sp, - str_2mortal(str_nmake(((double)timesbuf.tms_utime)/HZ))); - (void)astore(stack,++sp, - str_2mortal(str_nmake(((double)timesbuf.tms_stime)/HZ))); - (void)astore(stack,++sp, - str_2mortal(str_nmake(((double)timesbuf.tms_cutime)/HZ))); - (void)astore(stack,++sp, - str_2mortal(str_nmake(((double)timesbuf.tms_cstime)/HZ))); -#else - (void)astore(stack,++sp, - str_2mortal(str_nmake(0.0))); -#endif - return sp; -#endif -} - diff --git a/do/trans b/do/trans deleted file mode 100644 index f4c5503b43..0000000000 --- a/do/trans +++ /dev/null @@ -1,58 +0,0 @@ -int -do_trans(TARG,arg) -STR *TARG; -ARG *arg; -{ - register short *tbl; - register char *s; - register int matches = 0; - register int ch; - register char *send; - register char *d; - register int squash = arg[2].arg_len & 1; - - tbl = (short*) arg[2].arg_ptr.arg_cval; - s = str_get(TARG); - send = s + TARG->str_cur; - if (!tbl || !s) - fatal("panic: do_trans"); -#ifdef DEBUGGING - if (debug & 8) { - deb("2.TBL\n"); - } -#endif - if (!arg[2].arg_len) { - while (s < send) { - if ((ch = tbl[*s & 0377]) >= 0) { - matches++; - *s = ch; - } - s++; - } - } - else { - d = s; - while (s < send) { - if ((ch = tbl[*s & 0377]) >= 0) { - *d = ch; - if (matches++ && squash) { - if (d[-1] == *d) - matches--; - else - d++; - } - else - d++; - } - else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; /* -2 is delete character */ - s++; - } - matches += send - d; /* account for disappeared chars */ - *d = '\0'; - TARG->str_cur = d - TARG->str_ptr; - } - STABSET(TARG); - return matches; -} - diff --git a/do/truncate b/do/truncate deleted file mode 100644 index bf8306fcbb..0000000000 --- a/do/truncate +++ /dev/null @@ -1,55 +0,0 @@ -int /*SUPPRESS 590*/ -do_truncate(TARG,arg,gimme,arglast) -STR *TARG; -register ARG *arg; -int gimme; -int *arglast; -{ - register ARRAY *ary = stack; - register int sp = arglast[0] + 1; - off_t len = (off_t)str_gnum(ary->ary_array[sp+1]); - int result = 1; - STAB *tmpstab; - -#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) -#ifdef HAS_TRUNCATE - if ((arg[1].arg_type & A_MASK) == A_WORD) { - tmpstab = arg[1].arg_ptr.arg_stab; - if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp || - ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0) - result = 0; - } - else if (truncate(str_get(ary->ary_array[sp]), len) < 0) - result = 0; -#else - if ((arg[1].arg_type & A_MASK) == A_WORD) { - tmpstab = arg[1].arg_ptr.arg_stab; - if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp || - chsize(fileno(stab_io(tmpstab)->ifp), len) < 0) - result = 0; - } - else { - int tmpfd; - - if ((tmpfd = open(str_get(ary->ary_array[sp]), 0)) < 0) - result = 0; - else { - if (chsize(tmpfd, len) < 0) - result = 0; - close(tmpfd); - } - } -#endif - - if (result) - str_sset(TARG,&str_yes); - else - str_sset(TARG,&str_undef); - STABSET(TARG); - ary->ary_array[sp] = TARG; - return sp; -#else - fatal("truncate not implemented"); -#endif -} - diff --git a/do/undef b/do/undef deleted file mode 100644 index 092341b006..0000000000 --- a/do/undef +++ /dev/null @@ -1,59 +0,0 @@ -int /*SUPPRESS 590*/ -do_undef(TARG,arg,gimme,arglast) -STR *TARG; -register ARG *arg; -int gimme; -int *arglast; -{ - register int type; - register STAB *stab; - int retarg = arglast[0] + 1; - - if ((arg[1].arg_type & A_MASK) != A_LEXPR) - fatal("Illegal argument to undef()"); - arg = arg[1].arg_ptr.arg_arg; - type = arg->arg_type; - - if (type == O_ARRAY || type == O_LARRAY) { - stab = arg[1].arg_ptr.arg_stab; - afree(stab_xarray(stab)); - stab_xarray(stab) = anew(stab); /* so "@array" still works */ - } - else if (type == O_HASH || type == O_LHASH) { - stab = arg[1].arg_ptr.arg_stab; - if (stab == envstab) - environ[0] = Nullch; - else if (stab == sigstab) { - int i; - - for (i = 1; i < NSIG; i++) - signal(i, SIG_DFL); /* munch, munch, munch */ - } - (void)hfree(stab_xhash(stab), TRUE); - stab_xhash(stab) = Null(HASH*); - } - else if (type == O_SUBR || type == O_DBSUBR) { - stab = arg[1].arg_ptr.arg_stab; - if ((arg[1].arg_type & A_MASK) != A_WORD) { - STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab); - - if (tmpstr) - stab = stabent(str_get(tmpstr),TRUE); - else - stab = Nullstab; - } - if (stab && stab_sub(stab)) { - cmd_free(stab_sub(stab)->cmd); - stab_sub(stab)->cmd = Nullcmd; - afree(stab_sub(stab)->tosave); - Safefree(stab_sub(stab)); - stab_sub(stab) = Null(SUBR*); - } - } - else - fatal("Can't undefine that kind of object"); - str_numset(TARG,0.0); - stack->ary_array[retarg] = TARG; - return retarg; -} - diff --git a/do/unpack b/do/unpack deleted file mode 100644 index 81cca11656..0000000000 --- a/do/unpack +++ /dev/null @@ -1,561 +0,0 @@ -int -do_unpack(TARG,gimme,arglast) -STR *TARG; -int gimme; -int *arglast; -{ - STR **st = stack->ary_array; - register int sp = arglast[0] + 1; - register char *pat = str_get(st[sp++]); - register char *s = str_get(st[sp]); - char *strend = s + st[sp--]->str_cur; - char *strbeg = s; - register char *patend = pat + st[sp]->str_cur; - int datumtype; - register int len; - register int bits; - - /* These must not be in registers: */ - short ashort; - int aint; - long along; -#ifdef QUAD - quad aquad; -#endif - unsigned short aushort; - unsigned int auint; - unsigned long aulong; -#ifdef QUAD - unsigned quad auquad; -#endif - char *aptr; - float afloat; - double adouble; - int checksum = 0; - unsigned long culong; - double cdouble; - - if (gimme != G_ARRAY) { /* arrange to do first one only */ - /*SUPPRESS 530*/ - for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ; - if (index("aAbBhH", *patend) || *pat == '%') { - patend++; - while (isDIGIT(*patend) || *patend == '*') - patend++; - } - else - patend++; - } - sp--; - while (pat < patend) { - reparse: - datumtype = *pat++; - if (pat >= patend) - len = 1; - else if (*pat == '*') { - len = strend - strbeg; /* long enough */ - pat++; - } - else if (isDIGIT(*pat)) { - len = *pat++ - '0'; - while (isDIGIT(*pat)) - len = (len * 10) + (*pat++ - '0'); - } - else - len = (datumtype != '@'); - switch(datumtype) { - default: - break; - case '%': - if (len == 1 && pat[-1] != '1') - len = 16; - checksum = len; - culong = 0; - cdouble = 0; - if (pat < patend) - goto reparse; - break; - case '@': - if (len > strend - strbeg) - fatal("@ outside of string"); - s = strbeg + len; - break; - case 'X': - if (len > s - strbeg) - fatal("X outside of string"); - s -= len; - break; - case 'x': - if (len > strend - s) - fatal("x outside of string"); - s += len; - break; - case 'A': - case 'a': - if (len > strend - s) - len = strend - s; - if (checksum) - goto uchar_checksum; - TARG = Str_new(35,len); - str_nset(TARG,s,len); - s += len; - if (datumtype == 'A') { - aptr = s; /* borrow register */ - s = TARG->str_ptr + len - 1; - while (s >= TARG->str_ptr && (!*s || isSPACE(*s))) - s--; - *++s = '\0'; - TARG->str_cur = s - TARG->str_ptr; - s = aptr; /* unborrow register */ - } - (void)astore(stack, ++sp, str_2mortal(TARG)); - break; - case 'B': - case 'b': - if (pat[-1] == '*' || len > (strend - s) * 8) - len = (strend - s) * 8; - TARG = Str_new(35, len + 1); - TARG->str_cur = len; - TARG->str_pok = 1; - aptr = pat; /* borrow register */ - pat = TARG->str_ptr; - if (datumtype == 'b') { - aint = len; - for (len = 0; len < aint; len++) { - if (len & 7) /*SUPPRESS 595*/ - bits >>= 1; - else - bits = *s++; - *pat++ = '0' + (bits & 1); - } - } - else { - aint = len; - for (len = 0; len < aint; len++) { - if (len & 7) - bits <<= 1; - else - bits = *s++; - *pat++ = '0' + ((bits & 128) != 0); - } - } - *pat = '\0'; - pat = aptr; /* unborrow register */ - (void)astore(stack, ++sp, str_2mortal(TARG)); - break; - case 'H': - case 'h': - if (pat[-1] == '*' || len > (strend - s) * 2) - len = (strend - s) * 2; - TARG = Str_new(35, len + 1); - TARG->str_cur = len; - TARG->str_pok = 1; - aptr = pat; /* borrow register */ - pat = TARG->str_ptr; - if (datumtype == 'h') { - aint = len; - for (len = 0; len < aint; len++) { - if (len & 1) - bits >>= 4; - else - bits = *s++; - *pat++ = hexdigit[bits & 15]; - } - } - else { - aint = len; - for (len = 0; len < aint; len++) { - if (len & 1) - bits <<= 4; - else - bits = *s++; - *pat++ = hexdigit[(bits >> 4) & 15]; - } - } - *pat = '\0'; - pat = aptr; /* unborrow register */ - (void)astore(stack, ++sp, str_2mortal(TARG)); - break; - case 'c': - if (len > strend - s) - len = strend - s; - if (checksum) { - while (len-- > 0) { - aint = *s++; - if (aint >= 128) /* fake up signed chars */ - aint -= 256; - culong += aint; - } - } - else { - while (len-- > 0) { - aint = *s++; - if (aint >= 128) /* fake up signed chars */ - aint -= 256; - TARG = Str_new(36,0); - str_numset(TARG,(double)aint); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 'C': - if (len > strend - s) - len = strend - s; - if (checksum) { - uchar_checksum: - while (len-- > 0) { - auint = *s++ & 255; - culong += auint; - } - } - else { - while (len-- > 0) { - auint = *s++ & 255; - TARG = Str_new(37,0); - str_numset(TARG,(double)auint); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 's': - along = (strend - s) / sizeof(short); - if (len > along) - len = along; - if (checksum) { - while (len-- > 0) { - Copy(s,&ashort,1,short); - s += sizeof(short); - culong += ashort; - } - } - else { - while (len-- > 0) { - Copy(s,&ashort,1,short); - s += sizeof(short); - TARG = Str_new(38,0); - str_numset(TARG,(double)ashort); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 'v': - case 'n': - case 'S': - along = (strend - s) / sizeof(unsigned short); - if (len > along) - len = along; - if (checksum) { - while (len-- > 0) { - Copy(s,&aushort,1,unsigned short); - s += sizeof(unsigned short); -#ifdef HAS_NTOHS - if (datumtype == 'n') - aushort = ntohs(aushort); -#endif -#ifdef HAS_VTOHS - if (datumtype == 'v') - aushort = vtohs(aushort); -#endif - culong += aushort; - } - } - else { - while (len-- > 0) { - Copy(s,&aushort,1,unsigned short); - s += sizeof(unsigned short); - TARG = Str_new(39,0); -#ifdef HAS_NTOHS - if (datumtype == 'n') - aushort = ntohs(aushort); -#endif -#ifdef HAS_VTOHS - if (datumtype == 'v') - aushort = vtohs(aushort); -#endif - str_numset(TARG,(double)aushort); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 'i': - along = (strend - s) / sizeof(int); - if (len > along) - len = along; - if (checksum) { - while (len-- > 0) { - Copy(s,&aint,1,int); - s += sizeof(int); - if (checksum > 32) - cdouble += (double)aint; - else - culong += aint; - } - } - else { - while (len-- > 0) { - Copy(s,&aint,1,int); - s += sizeof(int); - TARG = Str_new(40,0); - str_numset(TARG,(double)aint); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 'I': - along = (strend - s) / sizeof(unsigned int); - if (len > along) - len = along; - if (checksum) { - while (len-- > 0) { - Copy(s,&auint,1,unsigned int); - s += sizeof(unsigned int); - if (checksum > 32) - cdouble += (double)auint; - else - culong += auint; - } - } - else { - while (len-- > 0) { - Copy(s,&auint,1,unsigned int); - s += sizeof(unsigned int); - TARG = Str_new(41,0); - str_numset(TARG,(double)auint); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 'l': - along = (strend - s) / sizeof(long); - if (len > along) - len = along; - if (checksum) { - while (len-- > 0) { - Copy(s,&along,1,long); - s += sizeof(long); - if (checksum > 32) - cdouble += (double)along; - else - culong += along; - } - } - else { - while (len-- > 0) { - Copy(s,&along,1,long); - s += sizeof(long); - TARG = Str_new(42,0); - str_numset(TARG,(double)along); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 'V': - case 'N': - case 'L': - along = (strend - s) / sizeof(unsigned long); - if (len > along) - len = along; - if (checksum) { - while (len-- > 0) { - Copy(s,&aulong,1,unsigned long); - s += sizeof(unsigned long); -#ifdef HAS_NTOHL - if (datumtype == 'N') - aulong = ntohl(aulong); -#endif -#ifdef HAS_VTOHL - if (datumtype == 'V') - aulong = vtohl(aulong); -#endif - if (checksum > 32) - cdouble += (double)aulong; - else - culong += aulong; - } - } - else { - while (len-- > 0) { - Copy(s,&aulong,1,unsigned long); - s += sizeof(unsigned long); - TARG = Str_new(43,0); -#ifdef HAS_NTOHL - if (datumtype == 'N') - aulong = ntohl(aulong); -#endif -#ifdef HAS_VTOHL - if (datumtype == 'V') - aulong = vtohl(aulong); -#endif - str_numset(TARG,(double)aulong); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 'p': - along = (strend - s) / sizeof(char*); - if (len > along) - len = along; - while (len-- > 0) { - if (sizeof(char*) > strend - s) - break; - else { - Copy(s,&aptr,1,char*); - s += sizeof(char*); - } - TARG = Str_new(44,0); - if (aptr) - str_set(TARG,aptr); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - break; -#ifdef QUAD - case 'q': - while (len-- > 0) { - if (s + sizeof(quad) > strend) - aquad = 0; - else { - Copy(s,&aquad,1,quad); - s += sizeof(quad); - } - TARG = Str_new(42,0); - str_numset(TARG,(double)aquad); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - break; - case 'Q': - while (len-- > 0) { - if (s + sizeof(unsigned quad) > strend) - auquad = 0; - else { - Copy(s,&auquad,1,unsigned quad); - s += sizeof(unsigned quad); - } - TARG = Str_new(43,0); - str_numset(TARG,(double)auquad); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - break; -#endif - /* float and double added gnb@melba.bby.oz.au 22/11/89 */ - case 'f': - case 'F': - along = (strend - s) / sizeof(float); - if (len > along) - len = along; - if (checksum) { - while (len-- > 0) { - Copy(s, &afloat,1, float); - s += sizeof(float); - cdouble += afloat; - } - } - else { - while (len-- > 0) { - Copy(s, &afloat,1, float); - s += sizeof(float); - TARG = Str_new(47, 0); - str_numset(TARG, (double)afloat); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 'd': - case 'D': - along = (strend - s) / sizeof(double); - if (len > along) - len = along; - if (checksum) { - while (len-- > 0) { - Copy(s, &adouble,1, double); - s += sizeof(double); - cdouble += adouble; - } - } - else { - while (len-- > 0) { - Copy(s, &adouble,1, double); - s += sizeof(double); - TARG = Str_new(48, 0); - str_numset(TARG, (double)adouble); - (void)astore(stack, ++sp, str_2mortal(TARG)); - } - } - break; - case 'u': - along = (strend - s) * 3 / 4; - TARG = Str_new(42,along); - while (s < strend && *s > ' ' && *s < 'a') { - int a,b,c,d; - char hunk[4]; - - hunk[3] = '\0'; - len = (*s++ - ' ') & 077; - while (len > 0) { - if (s < strend && *s >= ' ') - a = (*s++ - ' ') & 077; - else - a = 0; - if (s < strend && *s >= ' ') - b = (*s++ - ' ') & 077; - else - b = 0; - if (s < strend && *s >= ' ') - c = (*s++ - ' ') & 077; - else - c = 0; - if (s < strend && *s >= ' ') - d = (*s++ - ' ') & 077; - else - d = 0; - hunk[0] = a << 2 | b >> 4; - hunk[1] = b << 4 | c >> 2; - hunk[2] = c << 6 | d; - str_ncat(TARG,hunk, len > 3 ? 3 : len); - len -= 3; - } - if (*s == '\n') - s++; - else if (s[1] == '\n') /* possible checksum byte */ - s += 2; - } - (void)astore(stack, ++sp, str_2mortal(TARG)); - break; - } - if (checksum) { - TARG = Str_new(42,0); - if (index("fFdD", datumtype) || - (checksum > 32 && index("iIlLN", datumtype)) ) { - double modf(); - double trouble; - - adouble = 1.0; - while (checksum >= 16) { - checksum -= 16; - adouble *= 65536.0; - } - while (checksum >= 4) { - checksum -= 4; - adouble *= 16.0; - } - while (checksum--) - adouble *= 2.0; - along = (1 << checksum) - 1; - while (cdouble < 0.0) - cdouble += adouble; - cdouble = modf(cdouble / adouble, &trouble) * adouble; - str_numset(TARG,cdouble); - } - else { - if (checksum < 32) { - along = (1 << checksum) - 1; - culong &= (unsigned long)along; - } - str_numset(TARG,(double)culong); - } - (void)astore(stack, ++sp, str_2mortal(TARG)); - checksum = 0; - } - } - return sp; -} - diff --git a/do/unshift b/do/unshift deleted file mode 100644 index 26a3c7897e..0000000000 --- a/do/unshift +++ /dev/null @@ -1,20 +0,0 @@ -void -do_unshift(ary,arglast) -register ARRAY *ary; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int items = arglast[2] - sp; - register STR *TARG; - register int i; - - aunshift(ary,items); - i = 0; - for (st += ++sp; i < items; i++,st++) { - TARG = Str_new(27,0); - str_sset(TARG,*st); - (void)astore(ary,i,TARG); - } -} - diff --git a/do/vec b/do/vec deleted file mode 100644 index 37101adc28..0000000000 --- a/do/vec +++ /dev/null @@ -1,58 +0,0 @@ -int -do_vec(lvalue,astr,arglast) -int lvalue; -STR *astr; -int *arglast; -{ - STR **st = stack->ary_array; - int sp = arglast[0]; - register STR *TARG = st[++sp]; - register int offset = (int)str_gnum(st[++sp]); - register int size = (int)str_gnum(st[++sp]); - unsigned char *s = (unsigned char*)str_get(TARG); - unsigned long retnum; - int len; - - sp = arglast[1]; - offset *= size; /* turn into bit offset */ - len = (offset + size + 7) / 8; - if (offset < 0 || size < 1) - retnum = 0; - else if (!lvalue && len > TARG->str_cur) - retnum = 0; - else { - if (len > TARG->str_cur) { - STR_GROW(TARG,len); - (void)memzero(TARG->str_ptr + TARG->str_cur, len - TARG->str_cur); - TARG->str_cur = len; - } - s = (unsigned char*)str_get(TARG); - if (size < 8) - retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1); - else { - offset >>= 3; - if (size == 8) - retnum = s[offset]; - else if (size == 16) - retnum = ((unsigned long) s[offset] << 8) + s[offset+1]; - else if (size == 32) - retnum = ((unsigned long) s[offset] << 24) + - ((unsigned long) s[offset + 1] << 16) + - (s[offset + 2] << 8) + s[offset+3]; - } - - if (lvalue) { /* it's an lvalue! */ - struct lstring *lstr = (struct lstring*)astr; - - astr->str_magic = TARG; - st[sp]->str_rare = 'v'; - lstr->lstr_offset = offset; - lstr->lstr_len = size; - } - } - - str_numset(astr,(double)retnum); - st[sp] = astr; - return sp; -} - diff --git a/do/vecset b/do/vecset deleted file mode 100644 index 60b8d529f9..0000000000 --- a/do/vecset +++ /dev/null @@ -1,40 +0,0 @@ -void -do_vecset(mstr,TARG) -STR *mstr; -STR *TARG; -{ - struct lstring *lstr = (struct lstring*)TARG; - register int offset; - register int size; - register unsigned char *s = (unsigned char*)mstr->str_ptr; - register unsigned long lval = U_L(str_gnum(TARG)); - int mask; - - mstr->str_rare = 0; - TARG->str_magic = Nullstr; - offset = lstr->lstr_offset; - size = lstr->lstr_len; - if (size < 8) { - mask = (1 << size) - 1; - size = offset & 7; - lval &= mask; - offset >>= 3; - s[offset] &= ~(mask << size); - s[offset] |= lval << size; - } - else { - if (size == 8) - s[offset] = lval & 255; - else if (size == 16) { - s[offset] = (lval >> 8) & 255; - s[offset+1] = lval & 255; - } - else if (size == 32) { - s[offset] = (lval >> 24) & 255; - s[offset+1] = (lval >> 16) & 255; - s[offset+2] = (lval >> 8) & 255; - s[offset+3] = lval & 255; - } - } -} - diff --git a/do/vop b/do/vop deleted file mode 100644 index d91ef53ea6..0000000000 --- a/do/vop +++ /dev/null @@ -1,50 +0,0 @@ -void -do_vop(optype,TARG,left,right) -STR *TARG; -STR *left; -STR *right; -{ - register char *s; - register char *l = str_get(left); - register char *r = str_get(right); - register int len; - - len = left->str_cur; - if (len > right->str_cur) - len = right->str_cur; - if (TARG->str_cur > len) - TARG->str_cur = len; - else if (TARG->str_cur < len) { - STR_GROW(TARG,len); - (void)memzero(TARG->str_ptr + TARG->str_cur, len - TARG->str_cur); - TARG->str_cur = len; - } - TARG->str_pok = 1; - TARG->str_nok = 0; - s = TARG->str_ptr; - if (!s) { - str_nset(TARG,"",0); - s = TARG->str_ptr; - } - switch (optype) { - case O_BIT_AND: - while (len--) - *s++ = *l++ & *r++; - break; - case O_XOR: - while (len--) - *s++ = *l++ ^ *r++; - goto mop_up; - case O_BIT_OR: - while (len--) - *s++ = *l++ | *r++; - mop_up: - len = TARG->str_cur; - if (right->str_cur > len) - str_ncat(TARG,right->str_ptr+len,right->str_cur - len); - else if (left->str_cur > len) - str_ncat(TARG,left->str_ptr+len,left->str_cur - len); - break; - } -} - @@ -283,11 +283,11 @@ I32 len; dup2(fileno(fp), fd); sv = *av_fetch(fdpid,fileno(fp),TRUE); SvUPGRADE(sv, SVt_IV); - pid = SvIV(sv); - SvIV(sv) = 0; + pid = SvIVX(sv); + SvIVX(sv) = 0; sv = *av_fetch(fdpid,fd,TRUE); SvUPGRADE(sv, SVt_IV); - SvIV(sv) = pid; + SvIVX(sv) = pid; fclose(fp); } @@ -344,11 +344,12 @@ register GV *gv; } filemode = 0; while (av_len(GvAV(gv)) >= 0) { + STRLEN len; sv = av_shift(GvAV(gv)); sv_setsv(GvSV(gv),sv); SvSETMAGIC(GvSV(gv)); - oldname = SvPVnx(GvSV(gv)); - if (do_open(gv,oldname,SvCUR(GvSV(gv)))) { + oldname = SvPVx(GvSV(gv), len); + if (do_open(gv,oldname,len)) { if (inplace) { TAINT_PROPER("inplace open"); if (strEQ(oldname,"-")) { @@ -377,11 +378,11 @@ register GV *gv; sv_catpv(sv,inplace); #endif #ifndef FLEXFILENAMES - if (stat(SvPV(sv),&statbuf) >= 0 + if (stat(SvPVX(sv),&statbuf) >= 0 && statbuf.st_dev == filedev && statbuf.st_ino == fileino ) { warn("Can't do inplace edit: %s > 14 characters", - SvPV(sv) ); + SvPVX(sv) ); do_close(gv,FALSE); sv_free(sv); continue; @@ -389,24 +390,24 @@ register GV *gv; #endif #ifdef HAS_RENAME #ifndef DOSISH - if (rename(oldname,SvPV(sv)) < 0) { + if (rename(oldname,SvPVX(sv)) < 0) { warn("Can't rename %s to %s: %s, skipping file", - oldname, SvPV(sv), strerror(errno) ); + oldname, SvPVX(sv), strerror(errno) ); do_close(gv,FALSE); sv_free(sv); continue; } #else do_close(gv,FALSE); - (void)unlink(SvPV(sv)); - (void)rename(oldname,SvPV(sv)); - do_open(gv,SvPV(sv),SvCUR(GvSV(gv))); + (void)unlink(SvPVX(sv)); + (void)rename(oldname,SvPVX(sv)); + do_open(gv,SvPVX(sv),SvCUR(GvSV(gv))); #endif /* MSDOS */ #else - (void)UNLINK(SvPV(sv)); - if (link(oldname,SvPV(sv)) < 0) { + (void)UNLINK(SvPVX(sv)); + if (link(oldname,SvPVX(sv)) < 0) { warn("Can't rename %s to %s: %s, skipping file", - oldname, SvPV(sv), strerror(errno) ); + oldname, SvPVX(sv), strerror(errno) ); do_close(gv,FALSE); sv_free(sv); continue; @@ -418,20 +419,20 @@ register GV *gv; #ifndef DOSISH if (UNLINK(oldname) < 0) { warn("Can't rename %s to %s: %s, skipping file", - oldname, SvPV(sv), strerror(errno) ); + oldname, SvPVX(sv), strerror(errno) ); do_close(gv,FALSE); sv_free(sv); continue; } #else - fatal("Can't do inplace edit without backup"); + croak("Can't do inplace edit without backup"); #endif } sv_setpvn(sv,">",1); sv_catpv(sv,oldname); errno = 0; /* in case sprintf set errno */ - if (!do_open(argvoutgv,SvPV(sv),SvCUR(sv))) { + if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv))) { warn("Can't do inplace edit on %s: %s", oldname, strerror(errno) ); do_close(gv,FALSE); @@ -460,7 +461,7 @@ register GV *gv; return GvIO(gv)->ifp; } else - fprintf(stderr,"Can't open %s: %s\n",SvPVn(sv), strerror(errno)); + fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), strerror(errno)); sv_free(sv); } if (inplace) { @@ -682,7 +683,7 @@ SV *argstr; if (SvPOK(argstr) || !SvNIOK(argstr)) { if (!SvPOK(argstr)) - s = SvPVn(argstr); + s = SvPV(argstr, na); #ifdef IOCPARM_MASK #ifndef IOCPARM_LEN @@ -699,11 +700,11 @@ SV *argstr; SvCUR_set(argstr, retval); } - s = SvPV(argstr); + s = SvPVX(argstr); s[SvCUR(argstr)] = 17; /* a little sanity check here */ } else { - retval = SvIVn(argstr); + retval = SvIV(argstr); #ifdef DOSISH s = (char*)(long)retval; /* ouch */ #else @@ -716,12 +717,12 @@ SV *argstr; retval = ioctl(fileno(io->ifp), func, s); else #ifdef DOSISH - fatal("fcntl is not implemented"); + croak("fcntl is not implemented"); #else #ifdef HAS_FCNTL retval = fcntl(fileno(io->ifp), func, s); #else - fatal("fcntl is not implemented"); + croak("fcntl is not implemented"); #endif #endif #else /* lint */ @@ -730,7 +731,7 @@ SV *argstr; if (SvPOK(argstr)) { if (s[SvCUR(argstr)] != 17) - fatal("Return value overflowed string"); + croak("Return value overflowed string"); s[SvCUR(argstr)] = 0; /* put our null back */ } return retval; @@ -795,10 +796,17 @@ SV *sv; register char *s; register char *send; - if (!SvPOK(sv)) - return TRUE; - s = SvPV(sv); - send = s + SvCUR(sv); + if (!SvPOK(sv)) { + STRLEN len; + if (!SvPOKp(sv)) + return TRUE; + s = SvPV(sv, len); + send = s + len; + } + else { + s = SvPVX(sv); + send = s + SvCUR(sv); + } while (isSPACE(*s)) s++; if (s >= send) @@ -811,7 +819,7 @@ SV *sv; return TRUE; if (*s == '.') s++; - else if (s == SvPV(sv)) + else if (s == SvPVX(sv)) return FALSE; while (isDIGIT(*s)) s++; @@ -838,6 +846,7 @@ FILE *fp; { register char *tmps; SV* tmpstr; + STRLEN len; /* assuming fp is checked earlier */ if (!sv) @@ -845,13 +854,13 @@ FILE *fp; if (ofmt) { if (SvMAGICAL(sv)) mg_get(sv); - if (SvIOK(sv) && SvIV(sv) != 0) { - fprintf(fp, ofmt, (double)SvIV(sv)); + if (SvIOK(sv) && SvIVX(sv) != 0) { + fprintf(fp, ofmt, (double)SvIVX(sv)); return !ferror(fp); } - if ( (SvNOK(sv) && SvNV(sv) != 0.0) + if ( (SvNOK(sv) && SvNVX(sv) != 0.0) || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) { - fprintf(fp, ofmt, SvNV(sv)); + fprintf(fp, ofmt, SvNVX(sv)); return !ferror(fp); } } @@ -859,18 +868,18 @@ FILE *fp; case SVt_NULL: return TRUE; case SVt_REF: - fprintf(fp, "%s", sv_2pv(sv)); + fprintf(fp, "%s", sv_2pv(sv, &na)); return !ferror(fp); case SVt_IV: if (SvMAGICAL(sv)) mg_get(sv); - fprintf(fp, "%d", SvIV(sv)); + fprintf(fp, "%d", SvIVX(sv)); return !ferror(fp); default: - tmps = SvPVn(sv); + tmps = SvPV(sv, len); break; } - if (SvCUR(sv) && (fwrite(tmps,1,SvCUR(sv),fp) == 0 || ferror(fp))) + if (len && (fwrite(tmps,1,len,fp) == 0 || ferror(fp))) return FALSE; return TRUE; } @@ -906,10 +915,10 @@ dARGS dPOPss; PUTBACK; statgv = Nullgv; - sv_setpv(statname,SvPVn(sv)); + sv_setpv(statname,SvPV(sv, na)); laststype = OP_STAT; - laststatval = stat(SvPVn(sv),&statcache); - if (laststatval < 0 && dowarn && strchr(SvPVn(sv), '\n')) + laststatval = stat(SvPV(sv, na),&statcache); + if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n')) warn(warn_nl, "stat"); return laststatval; } @@ -925,23 +934,23 @@ dARGS EXTEND(sp,1); if (cGVOP->op_gv == defgv) { if (laststype != OP_LSTAT) - fatal("The stat preceding -l _ wasn't an lstat"); + croak("The stat preceding -l _ wasn't an lstat"); return laststatval; } - fatal("You can't use -l on a filehandle"); + croak("You can't use -l on a filehandle"); } laststype = OP_LSTAT; statgv = Nullgv; sv = POPs; PUTBACK; - sv_setpv(statname,SvPVn(sv)); + sv_setpv(statname,SvPV(sv, na)); #ifdef HAS_LSTAT - laststatval = lstat(SvPVn(sv),&statcache); + laststatval = lstat(SvPV(sv, na),&statcache); #else - laststatval = stat(SvPVn(sv),&statcache); + laststatval = stat(SvPV(sv, na),&statcache); #endif - if (laststatval < 0 && dowarn && strchr(SvPVn(sv), '\n')) + if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n')) warn(warn_nl, "lstat"); return laststatval; } @@ -960,14 +969,14 @@ register SV **sp; a = Argv; while (++mark <= sp) { if (*mark) - *a++ = SvPVnx(*mark); + *a++ = SvPVx(*mark, na); else *a++ = ""; } *a = Nullch; if (*Argv[0] != '/') /* will execvp use PATH? */ TAINT_ENV(); /* testing IFS here is overkill, probably */ - if (really && *(tmps = SvPVn(really))) + if (really && *(tmps = SvPV(really, na))) execvp(tmps,Argv); else execvp(Argv[0],Argv); @@ -1078,19 +1087,21 @@ register SV **sp; char *s; SV **oldmark = mark; -#ifdef TAINT - while (++mark <= sp) - TAINT_IF((*mark)->sv_tainted); - mark = oldmark; -#endif + if (tainting) { + while (++mark <= sp) { + if (SvMAGICAL(*mark) && mg_find(*mark, 't')) + tainted = TRUE; + } + mark = oldmark; + } switch (type) { case OP_CHMOD: TAINT_PROPER("chmod"); if (++mark <= sp) { tot = sp - mark; - val = SvIVnx(*mark); + val = SvIVx(*mark); while (++mark <= sp) { - if (chmod(SvPVnx(*mark),val)) + if (chmod(SvPVx(*mark, na),val)) tot--; } } @@ -1100,10 +1111,10 @@ register SV **sp; TAINT_PROPER("chown"); if (sp - mark > 2) { tot = sp - mark; - val = SvIVnx(*++mark); - val2 = SvIVnx(*++mark); + val = SvIVx(*++mark); + val2 = SvIVx(*++mark); while (++mark <= sp) { - if (chown(SvPVnx(*mark),val,val2)) + if (chown(SvPVx(*mark, na),val,val2)) tot--; } } @@ -1112,20 +1123,20 @@ register SV **sp; #ifdef HAS_KILL case OP_KILL: TAINT_PROPER("kill"); - s = SvPVnx(*++mark); + s = SvPVx(*++mark, na); tot = sp - mark; if (isUPPER(*s)) { if (*s == 'S' && s[1] == 'I' && s[2] == 'G') s += 3; if (!(val = whichsig(s))) - fatal("Unrecognized signal name \"%s\"",s); + croak("Unrecognized signal name \"%s\"",s); } else - val = SvIVnx(*mark); + val = SvIVx(*mark); if (val < 0) { val = -val; while (++mark <= sp) { - I32 proc = SvIVnx(*mark); + I32 proc = SvIVx(*mark); #ifdef HAS_KILLPG if (killpg(proc,val)) /* BSD */ #else @@ -1136,7 +1147,7 @@ register SV **sp; } else { while (++mark <= sp) { - if (kill(SvIVnx(*mark),val)) + if (kill(SvIVx(*mark),val)) tot--; } } @@ -1146,7 +1157,7 @@ register SV **sp; TAINT_PROPER("unlink"); tot = sp - mark; while (++mark <= sp) { - s = SvPVnx(*mark); + s = SvPVx(*mark, na); if (euid || unsafe) { if (UNLINK(s)) tot--; @@ -1178,11 +1189,11 @@ register SV **sp; #endif Zero(&utbuf, sizeof utbuf, char); - utbuf.actime = SvIVnx(*++mark); /* time accessed */ - utbuf.modtime = SvIVnx(*++mark); /* time modified */ + utbuf.actime = SvIVx(*++mark); /* time accessed */ + utbuf.modtime = SvIVx(*++mark); /* time modified */ tot = sp - mark; while (++mark <= sp) { - if (utime(SvPVnx(*mark),&utbuf)) + if (utime(SvPVx(*mark, na),&utbuf)) tot--; } } @@ -1284,9 +1295,9 @@ SV **sp; key_t key; I32 n, flags; - key = (key_t)SvNVnx(*++mark); - n = (optype == OP_MSGGET) ? 0 : SvIVnx(*++mark); - flags = SvIVnx(*++mark); + key = (key_t)SvNVx(*++mark); + n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark); + flags = SvIVx(*++mark); errno = 0; switch (optype) { @@ -1304,7 +1315,7 @@ SV **sp; #endif #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM) default: - fatal("%s not implemented", op_name[optype]); + croak("%s not implemented", op_name[optype]); #endif } return -1; /* should never happen */ @@ -1320,9 +1331,9 @@ SV **sp; char *a; I32 id, n, cmd, infosize, getinfo, ret; - id = SvIVnx(*++mark); - n = (optype == OP_SEMCTL) ? SvIVnx(*++mark) : 0; - cmd = SvIVnx(*++mark); + id = SvIVx(*++mark); + n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; + cmd = SvIVx(*++mark); astr = *++mark; infosize = 0; getinfo = (cmd == IPC_STAT); @@ -1359,7 +1370,7 @@ SV **sp; #endif #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM) default: - fatal("%s not implemented", op_name[optype]); + croak("%s not implemented", op_name[optype]); #endif } @@ -1367,22 +1378,23 @@ SV **sp; { if (getinfo) { + if (SvREADONLY(astr)) + croak("Can't %s to readonly var", op_name[optype]); SvGROW(astr, infosize+1); - a = SvPVn(astr); + a = SvPV(astr, na); } else { - a = SvPVn(astr); - if (SvCUR(astr) != infosize) - { - errno = EINVAL; - return -1; - } + STRLEN len; + a = SvPV(astr, len); + if (len != infosize) + croak("Bad arg length for %s, is %d, should be %d", + op_name[optype], len, infosize); } } else { - I32 i = SvIVn(astr); + I32 i = SvIV(astr); a = (char *)i; /* ouch */ } errno = 0; @@ -1420,19 +1432,18 @@ SV **sp; SV *mstr; char *mbuf; I32 id, msize, flags; + STRLEN len; - id = SvIVnx(*++mark); + id = SvIVx(*++mark); mstr = *++mark; - flags = SvIVnx(*++mark); - mbuf = SvPVn(mstr); - if ((msize = SvCUR(mstr) - sizeof(long)) < 0) { - errno = EINVAL; - return -1; - } + flags = SvIVx(*++mark); + mbuf = SvPV(mstr, len); + if ((msize = len - sizeof(long)) < 0) + croak("Arg too short for msgsnd"); errno = 0; return msgsnd(id, (struct msgbuf *)mbuf, msize, flags); #else - fatal("msgsnd not implemented"); + croak("msgsnd not implemented"); #endif } @@ -1446,16 +1457,19 @@ SV **sp; char *mbuf; long mtype; I32 id, msize, flags, ret; + STRLEN len; - id = SvIVnx(*++mark); + id = SvIVx(*++mark); mstr = *++mark; - msize = SvIVnx(*++mark); - mtype = (long)SvIVnx(*++mark); - flags = SvIVnx(*++mark); - mbuf = SvPVn(mstr); - if (SvCUR(mstr) < sizeof(long)+msize+1) { + msize = SvIVx(*++mark); + mtype = (long)SvIVx(*++mark); + flags = SvIVx(*++mark); + if (SvREADONLY(mstr)) + croak("Can't msgrcv to readonly var"); + mbuf = SvPV(mstr, len); + if (len < sizeof(long)+msize+1) { SvGROW(mstr, sizeof(long)+msize+1); - mbuf = SvPVn(mstr); + mbuf = SvPV(mstr, len); } errno = 0; ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags); @@ -1465,7 +1479,7 @@ SV **sp; } return ret; #else - fatal("msgrcv not implemented"); + croak("msgrcv not implemented"); #endif } @@ -1477,12 +1491,12 @@ SV **sp; #ifdef HAS_SEM SV *opstr; char *opbuf; - I32 id, opsize; + I32 id; + STRLEN opsize; - id = SvIVnx(*++mark); + id = SvIVx(*++mark); opstr = *++mark; - opbuf = SvPVn(opstr); - opsize = SvCUR(opstr); + opbuf = SvPV(opstr, opsize); if (opsize < sizeof(struct sembuf) || (opsize % sizeof(struct sembuf)) != 0) { errno = EINVAL; @@ -1491,7 +1505,7 @@ SV **sp; errno = 0; return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf)); #else - fatal("semop not implemented"); + croak("semop not implemented"); #endif } @@ -1505,15 +1519,16 @@ SV **sp; SV *mstr; char *mbuf, *shm; I32 id, mpos, msize; + STRLEN len; struct shmid_ds shmds; #ifndef VOIDSHMAT extern char *shmat(); #endif - id = SvIVnx(*++mark); + id = SvIVx(*++mark); mstr = *++mark; - mpos = SvIVnx(*++mark); - msize = SvIVnx(*++mark); + mpos = SvIVx(*++mark); + msize = SvIVx(*++mark); errno = 0; if (shmctl(id, IPC_STAT, &shmds) == -1) return -1; @@ -1524,11 +1539,13 @@ SV **sp; shm = (char*)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0); if (shm == (char *)-1) /* I hate System V IPC, I really do */ return -1; - mbuf = SvPVn(mstr); + mbuf = SvPV(mstr, len); if (optype == OP_SHMREAD) { - if (SvCUR(mstr) < msize) { + if (SvREADONLY(mstr)) + croak("Can't shmread to readonly var"); + if (len < msize) { SvGROW(mstr, msize+1); - mbuf = SvPVn(mstr); + mbuf = SvPV(mstr, len); } Copy(shm + mpos, mbuf, msize, char); SvCUR_set(mstr, msize); @@ -1537,7 +1554,7 @@ SV **sp; else { I32 n; - if ((n = SvCUR(mstr)) > msize) + if ((n = len) > msize) n = msize; Copy(mbuf, shm + mpos, n, char); if (n < msize) @@ -1545,7 +1562,7 @@ SV **sp; } return shmdt(shm); #else - fatal("shm I/O not implemented"); + croak("shm I/O not implemented"); #endif } diff --git a/dolist.c b/dolist.c deleted file mode 100644 index da21ccaebb..0000000000 --- a/dolist.c +++ /dev/null @@ -1,117 +0,0 @@ -/* $RCSfile: dolist.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:51 $ - * - * 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: dolist.c,v $ - * Revision 4.1 92/08/07 17:19:51 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.5 92/06/08 13:13:27 lwall - * patch20: g pattern modifer sometimes returned extra values - * patch20: m/$pattern/g didn't work - * patch20: pattern modifiers i and o didn't interact right - * patch20: @ in unpack failed too often - * patch20: Perl now distinguishes overlapped copies from non-overlapped - * patch20: slice on null list in scalar context returned random value - * patch20: splice with negative offset didn't work with $[ = 1 - * patch20: fixed some memory leaks in splice - * patch20: scalar keys %array now counts keys for you - * - * Revision 4.0.1.4 91/11/11 16:33:19 lwall - * patch19: added little-endian pack/unpack options - * patch19: sort $subname was busted by changes in 4.018 - * - * Revision 4.0.1.3 91/11/05 17:07:02 lwall - * patch11: prepared for ctype implementations that don't define isascii() - * patch11: /$foo/o optimizer could access deallocated data - * patch11: certain optimizations of //g in array context returned too many values - * patch11: regexp with no parens in array context returned wacky $`, $& and $' - * patch11: $' not set right on some //g - * patch11: added some support for 64-bit integers - * patch11: grep of a split lost its values - * patch11: added sort {} LIST - * patch11: multiple reallocations now avoided in 1 .. 100000 - * - * Revision 4.0.1.2 91/06/10 01:22:15 lwall - * patch10: //g only worked first time through - * - * Revision 4.0.1.1 91/06/07 10:58:28 lwall - * patch4: new copyright notice - * patch4: added global modifier for pattern matches - * patch4: // wouldn't use previous pattern if it started with a null character - * patch4: //o and s///o now optimize themselves fully at runtime - * patch4: $` was busted inside s/// - * patch4: caller($arg) didn't work except under debugger - * - * Revision 4.0 91/03/20 01:08:03 lwall - * 4.0 baseline. - * - */ - -#include "EXTERN.h" -#include "perl.h" - -#ifdef BUGGY_MSC - #pragma function(memcmp) -#endif /* BUGGY_MSC */ - -#ifdef BUGGY_MSC - #pragma intrinsic(memcmp) -#endif /* BUGGY_MSC */ - -OP * -do_kv(ARGS) -dARGS -{ - dSP; - HV *hash = (HV*)POPs; - register AV *ary = stack; - I32 i; - register HE *entry; - char *tmps; - SV *tmpstr; - I32 dokeys = (op->op_type == OP_KEYS || op->op_type == OP_RV2HV); - I32 dovalues = (op->op_type == OP_VALUES || op->op_type == OP_RV2HV); - - if (!hash) - RETURN; - if (GIMME != G_ARRAY) { - dTARGET; - - i = 0; - (void)hv_iterinit(hash); - /*SUPPRESS 560*/ - while (entry = hv_iternext(hash)) { - i++; - } - PUSHn( (double)i ); - RETURN; - } - /* Guess how much room we need. hv_max may be a few too many. Oh well. */ - EXTEND(sp, HvMAX(hash) * (dokeys + dovalues)); - (void)hv_iterinit(hash); - /*SUPPRESS 560*/ - while (entry = hv_iternext(hash)) { - if (dokeys) { - tmps = hv_iterkey(entry,&i); - if (!i) - tmps = ""; - XPUSHs(sv_2mortal(newSVpv(tmps,i))); - } - if (dovalues) { - tmpstr = NEWSV(45,0); - sv_setsv(tmpstr,hv_iterval(hash,entry)); - DEBUG_H( { - sprintf(buf,"%d%%%d=%d\n",entry->hent_hash, - HvMAX(hash)+1,entry->hent_hash & HvMAX(hash)); - sv_setpv(tmpstr,buf); - } ) - XPUSHs(sv_2mortal(tmpstr)); - } - } - RETURN; -} - @@ -86,12 +86,13 @@ OP *arg; register char *send; register char *d; register I32 squash = op->op_private & OPpTRANS_SQUASH; + STRLEN len; tbl = (short*) cPVOP->op_pv; - s = SvPVn(sv); - send = s + SvCUROK(sv); + s = SvPV(sv, len); + send = s + len; if (!tbl || !s) - fatal("panic: do_trans"); + croak("panic: do_trans"); DEBUG_t( deb("2.TBL\n")); if (!op->op_private) { while (s < send) { @@ -122,7 +123,7 @@ OP *arg; } matches += send - d; /* account for disappeared chars */ *d = '\0'; - SvCUR_set(sv, d - SvPV(sv)); + SvCUR_set(sv, d - SvPVX(sv)); } SvSETMAGIC(sv); return matches; @@ -137,9 +138,10 @@ register SV **sp; { SV **oldmark = mark; register I32 items = sp - mark; - register char *delim = SvPVn(del); register STRLEN len; - I32 delimlen = SvCUROK(del); + STRLEN delimlen; + register char *delim = SvPV(del, delimlen); + STRLEN tmplen; mark++; len = (items > 0 ? (delimlen * (items - 1) ) : 0); @@ -148,12 +150,8 @@ register SV **sp; if (SvLEN(sv) < len + items) { /* current length is way too short */ while (items-- > 0) { if (*mark) { - if (!SvPOK(*mark)) { - sv_2pv(*mark); - if (!SvPOK(*mark)) - *mark = &sv_no; - } - len += SvCUR((*mark)); + SvPV(*mark, tmplen); + len += tmplen; } mark++; } @@ -164,8 +162,11 @@ register SV **sp; ++mark; } - if (items-- > 0) - sv_setsv(sv, *mark++); + if (items-- > 0) { + char *s = SvPV(*mark, tmplen); + sv_setpvn(sv, s, tmplen); + mark++; + } else sv_setpv(sv,""); len = delimlen; @@ -203,11 +204,12 @@ register SV **sarg; I32 pre; I32 post; double value; + STRLEN arglen; sv_setpv(sv,""); len--; /* don't count pattern string */ - t = s = SvPVn(*sarg); - send = s + SvCUROK(*sarg); + t = s = SvPV(*sarg, arglen); + send = s + arglen; sarg++; for ( ; ; len--) { @@ -240,7 +242,7 @@ register SV **sarg; case '5': case '6': case '7': case '8': case '9': case '.': case '#': case '-': case '+': case ' ': continue; - case 'lXXX': + case 'l': #ifdef QUAD if (dolong) { dolong = FALSE; @@ -252,7 +254,7 @@ register SV **sarg; case 'c': ch = *(++t); *t = '\0'; - xlen = SvIVn(arg); + xlen = SvIV(arg); if (strEQ(f,"%c")) { /* some printfs fail on null chars */ *xs = xlen; xs[1] = '\0'; @@ -271,13 +273,13 @@ register SV **sarg; *t = '\0'; #ifdef QUAD if (doquad) - (void)sprintf(buf,s,(quad)SvNVn(arg)); + (void)sprintf(buf,s,(quad)SvNV(arg)); else #endif if (dolong) - (void)sprintf(xs,f,(long)SvNVn(arg)); + (void)sprintf(xs,f,(long)SvNV(arg)); else - (void)sprintf(xs,f,SvIVn(arg)); + (void)sprintf(xs,f,SvIV(arg)); xlen = strlen(xs); break; case 'X': case 'O': @@ -286,7 +288,7 @@ register SV **sarg; case 'x': case 'o': case 'u': ch = *(++t); *t = '\0'; - value = SvNVn(arg); + value = SvNV(arg); #ifdef QUAD if (doquad) (void)sprintf(buf,s,(unsigned quad)value); @@ -301,17 +303,14 @@ register SV **sarg; case 'E': case 'e': case 'f': case 'G': case 'g': ch = *(++t); *t = '\0'; - (void)sprintf(xs,f,SvNVn(arg)); + (void)sprintf(xs,f,SvNV(arg)); xlen = strlen(xs); break; case 's': ch = *(++t); *t = '\0'; - xs = SvPVn(arg); - if (SvPOK(arg)) - xlen = SvCUR(arg); - else - xlen = strlen(xs); + xs = SvPV(arg, arglen); + xlen = (I32)arglen; if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */ break; /* so handle simple cases */ } @@ -355,12 +354,12 @@ register SV **sarg; SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post); sv_catpvn(sv, s, f - s); if (pre) { - repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, pre); + repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre); SvCUR(sv) += pre; } sv_catpvn(sv, xs, xlen); if (post) { - repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, post); + repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post); SvCUR(sv) += post; } s = t; @@ -378,8 +377,8 @@ SV *sv; SV *targ = LvTARG(sv); register I32 offset; register I32 size; - register unsigned char *s = (unsigned char*)SvPV(targ); - register unsigned long lval = U_L(SvNVn(sv)); + register unsigned char *s = (unsigned char*)SvPVX(targ); + register unsigned long lval = U_L(SvNV(sv)); I32 mask; offset = LvTARGOFF(sv); @@ -416,11 +415,14 @@ register SV *sv; register char *tmps; register I32 i; AV *ary; - HV *hash; + HV *hv; HE *entry; + STRLEN len; if (!sv) return; + if (SvREADONLY(sv)) + croak("Can't chop readonly value"); if (SvTYPE(sv) == SVt_PVAV) { I32 max; SV **array = AvARRAY(sv); @@ -430,19 +432,19 @@ register SV *sv; return; } if (SvTYPE(sv) == SVt_PVHV) { - hash = (HV*)sv; - (void)hv_iterinit(hash); + hv = (HV*)sv; + (void)hv_iterinit(hv); /*SUPPRESS 560*/ - while (entry = hv_iternext(hash)) - do_chop(astr,hv_iterval(hash,entry)); + while (entry = hv_iternext(hv)) + do_chop(astr,hv_iterval(hv,entry)); return; } - tmps = SvPVn(sv); - if (tmps && SvCUROK(sv)) { - tmps += SvCUR(sv) - 1; + tmps = SvPV(sv, len); + if (tmps && len) { + tmps += len - 1; sv_setpvn(astr,tmps,1); /* remember last char */ *tmps = '\0'; /* wipe it out */ - SvCUR_set(sv, tmps - SvPV(sv)); + SvCUR_set(sv, tmps - SvPVX(sv)); SvNOK_off(sv); SvSETMAGIC(sv); } @@ -463,12 +465,14 @@ SV *right; register long *rl; #endif register char *dc; - register char *lc = SvPVn(left); - register char *rc = SvPVn(right); + STRLEN leftlen; + STRLEN rightlen; + register char *lc = SvPV(left, leftlen); + register char *rc = SvPV(right, rightlen); register I32 len; - I32 leftlen = SvCUROK(left); - I32 rightlen = SvCUROK(right); + if (SvREADONLY(sv)) + croak("Can't do %s to readonly value", op_name[optype]); len = leftlen < rightlen ? leftlen : rightlen; if (SvTYPE(sv) < SVt_PV) sv_upgrade(sv, SVt_PV); @@ -476,14 +480,14 @@ SV *right; SvCUR_set(sv, len); else if (SvCUR(sv) < len) { SvGROW(sv,len); - (void)memzero(SvPV(sv) + SvCUR(sv), len - SvCUR(sv)); + (void)memzero(SvPVX(sv) + SvCUR(sv), len - SvCUR(sv)); SvCUR_set(sv, len); } SvPOK_only(sv); - dc = SvPV(sv); + dc = SvPVX(sv); if (!dc) { sv_setpvn(sv,"",0); - dc = SvPV(sv); + dc = SvPVX(sv); } #ifdef LIBERAL if (len >= sizeof(long)*4 && @@ -546,9 +550,74 @@ SV *right; mop_up: len = SvCUR(sv); if (rightlen > len) - sv_catpvn(sv, SvPV(right) + len, rightlen - len); + sv_catpvn(sv, SvPVX(right) + len, rightlen - len); else if (leftlen > len) - sv_catpvn(sv, SvPV(left) + len, leftlen - len); + sv_catpvn(sv, SvPVX(left) + len, leftlen - len); break; } } + +OP * +do_kv(ARGS) +dARGS +{ + dSP; + HV *hv = (HV*)POPs; + register AV *ary = stack; + I32 i; + register HE *entry; + char *tmps; + SV *tmpstr; + I32 dokeys = (op->op_type == OP_KEYS || op->op_type == OP_RV2HV); + I32 dovalues = (op->op_type == OP_VALUES || op->op_type == OP_RV2HV); + + if (!hv) + RETURN; + if (GIMME != G_ARRAY) { + dTARGET; + + if (!SvMAGICAL(hv) || !mg_find((SV*)hv,'P')) + i = HvKEYS(hv); + else { + i = 0; + (void)hv_iterinit(hv); + /*SUPPRESS 560*/ + while (entry = hv_iternext(hv)) { + i++; + } + } + PUSHi( i ); + RETURN; + } + + /* Guess how much room we need. hv_max may be a few too many. Oh well. */ + EXTEND(sp, HvMAX(hv) * (dokeys + dovalues)); + + (void)hv_iterinit(hv); + + PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */ + while (entry = hv_iternext(hv)) { + SPAGAIN; + if (dokeys) { + tmps = hv_iterkey(entry,&i); /* won't clobber stack_sp */ + if (!i) + tmps = ""; + XPUSHs(sv_2mortal(newSVpv(tmps,i))); + } + if (dovalues) { + tmpstr = NEWSV(45,0); + PUTBACK; + sv_setsv(tmpstr,hv_iterval(hv,entry)); + SPAGAIN; + DEBUG_H( { + sprintf(buf,"%d%%%d=%d\n",entry->hent_hash, + HvMAX(hv)+1,entry->hent_hash & HvMAX(hv)); + sv_setpv(tmpstr,buf); + } ) + XPUSHs(sv_2mortal(tmpstr)); + } + PUTBACK; + } + return NORMAL; +} + diff --git a/doop.c2 b/doop.c2 deleted file mode 100644 index ea5fec7a83..0000000000 --- a/doop.c2 +++ /dev/null @@ -1,571 +0,0 @@ -/* $RCSfile: doarg.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:37 $ - * - * 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: doarg.c,v $ - * Revision 4.1 92/08/07 17:19:37 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.7 92/06/11 21:07:11 lwall - * patch34: join with null list attempted negative allocation - * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd " - * - * Revision 4.0.1.6 92/06/08 12:34:30 lwall - * patch20: removed implicit int declarations on funcions - * patch20: pattern modifiers i and o didn't interact right - * patch20: join() now pre-extends target string to avoid excessive copying - * patch20: fixed confusion between a *var's real name and its effective name - * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly - * patch20: usersub routines didn't reclaim temp values soon enough - * patch20: ($<,$>) = ... didn't work on some architectures - * patch20: added Atari ST portability - * - * Revision 4.0.1.5 91/11/11 16:31:58 lwall - * patch19: added little-endian pack/unpack options - * - * Revision 4.0.1.4 91/11/05 16:35:06 lwall - * patch11: /$foo/o optimizer could access deallocated data - * patch11: minimum match length calculation in regexp is now cumulative - * patch11: added some support for 64-bit integers - * patch11: prepared for ctype implementations that don't define isascii() - * patch11: sprintf() now supports any length of s field - * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work - * patch11: defined(&$foo) and undef(&$foo) didn't work - * - * Revision 4.0.1.3 91/06/10 01:18:41 lwall - * patch10: pack(hh,1) dumped core - * - * Revision 4.0.1.2 91/06/07 10:42:17 lwall - * patch4: new copyright notice - * patch4: // wouldn't use previous pattern if it started with a null character - * patch4: //o and s///o now optimize themselves fully at runtime - * patch4: added global modifier for pattern matches - * patch4: undef @array disabled "@array" interpolation - * patch4: chop("") was returning "\0" rather than "" - * patch4: vector logical operations &, | and ^ sometimes returned null string - * patch4: syscall couldn't pass numbers with most significant bit set on sparcs - * - * Revision 4.0.1.1 91/04/11 17:40:14 lwall - * patch1: fixed undefined environ problem - * patch1: fixed debugger coredump on subroutines - * - * Revision 4.0 91/03/20 01:06:42 lwall - * 4.0 baseline. - * - */ - -#include "EXTERN.h" -#include "perl.h" - -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) -#include <signal.h> -#endif - -#ifdef BUGGY_MSC - #pragma function(memcmp) -#endif /* BUGGY_MSC */ - -static void doencodes(); - -#ifdef BUGGY_MSC - #pragma intrinsic(memcmp) -#endif /* BUGGY_MSC */ - -int -do_trans(sv,arg) -SV *sv; -OP *arg; -{ - register short *tbl; - register char *s; - register int matches = 0; - register int ch; - register char *send; - register char *d; - register int squash = op->op_private & OPpTRANS_SQUASH; - - tbl = (short*) cPVOP->op_pv; - s = SvPV(sv); - send = s + sv->sv_cur; - if (!tbl || !s) - fatal("panic: do_trans"); -#ifdef DEBUGGING - if (debug & 8) { - deb("2.TBL\n"); - } -#endif - if (!op->op_private) { - while (s < send) { - if ((ch = tbl[*s & 0377]) >= 0) { - matches++; - *s = ch; - } - s++; - } - } - else { - d = s; - while (s < send) { - if ((ch = tbl[*s & 0377]) >= 0) { - *d = ch; - if (matches++ && squash) { - if (d[-1] == *d) - matches--; - else - d++; - } - else - d++; - } - else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; /* -2 is delete character */ - s++; - } - matches += send - d; /* account for disappeared chars */ - *d = '\0'; - sv->sv_cur = d - sv->sv_ptr; - } - SvSETMAGIC(sv); - return matches; -} - -void -do_join(sv,del,mark,sp) -register SV *sv; -SV *del; -register SV **mark; -register SV **sp; -{ - SV **oldmark = mark; - register int items = sp - mark; - register char *delim = SvPV(del); - register STRLEN len; - int delimlen = del->sv_cur; - - mark++; - len = (items > 0 ? (delimlen * (items - 1) ) : 0); - if (sv->sv_len < len + items) { /* current length is way too short */ - while (items-- > 0) { - if (*mark) - len += (*mark)->sv_cur; - mark++; - } - SvGROW(sv, len + 1); /* so try to pre-extend */ - - mark = oldmark; - items = sp - mark;; - ++mark; - } - - if (items-- > 0) - sv_setsv(sv, *mark++); - else - sv_setpv(sv,""); - len = delimlen; - if (len) { - for (; items > 0; items--,mark++) { - sv_catpvn(sv,delim,len); - sv_catsv(sv,*mark); - } - } - else { - for (; items > 0; items--,mark++) - sv_catsv(sv,*mark); - } - SvSETMAGIC(sv); -} - -void -do_sprintf(sv,numargs,firstarg) -register SV *sv; -int numargs; -SV **firstarg; -{ - register char *s; - register char *t; - register char *f; - register int argix = 0; - register SV **sarg = firstarg; - bool dolong; -#ifdef QUAD - bool doquad; -#endif /* QUAD */ - char ch; - register char *send; - register SV *arg; - char *xs; - int xlen; - int pre; - int post; - double value; - - sv_setpv(sv,""); - len--; /* don't count pattern string */ - t = s = SvPV(*sarg); - send = s + (*sarg)->sv_cur; - sarg++; - for ( ; ; argix++) { - - /*SUPPRESS 530*/ - for ( ; t < send && *t != '%'; t++) ; - if (t >= send) - break; /* end of run_format string, ignore extra args */ - f = t; - if (t[2] == '$' && isDIGIT(t[1])) { - ch = *(++t); - *t = '\0'; - (void)sprintf(xs,t); - sv_catpvn(sv, xs, xlen); - argix = atoi(t+1); - sarg = firstarg + argix; - t[2] = '%'; - f += 2; - - } - /*SUPPRESS 560*/ - if (argix > numargs || !(arg = *sarg++)) - arg = &sv_no; - - *buf = '\0'; - xs = buf; -#ifdef QUAD - doquad = -#endif /* QUAD */ - dolong = FALSE; - pre = post = 0; - for (t++; t < send; t++) { - switch (*t) { - default: - ch = *(++t); - *t = '\0'; - (void)sprintf(xs,f); - argix--, sarg--; - xlen = strlen(xs); - break; - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - case '.': case '#': case '-': case '+': case ' ': - continue; - case 'l': -#ifdef QUAD - if (dolong) { - dolong = FALSE; - doquad = TRUE; - } else -#endif - dolong = TRUE; - continue; - case 'c': - ch = *(++t); - *t = '\0'; - xlen = (int)SvNV(arg); - if (strEQ(f,"%c")) { /* some printfs fail on null chars */ - *xs = xlen; - xs[1] = '\0'; - xlen = 1; - } - else { - (void)sprintf(xs,f,xlen); - xlen = strlen(xs); - } - break; - case 'D': - dolong = TRUE; - /* FALL THROUGH */ - case 'd': - ch = *(++t); - *t = '\0'; -#ifdef QUAD - if (doquad) - (void)sprintf(buf,s,(quad)SvNV(arg)); - else -#endif - if (dolong) - (void)sprintf(xs,f,(long)SvNV(arg)); - else - (void)sprintf(xs,f,(int)SvNV(arg)); - xlen = strlen(xs); - break; - case 'X': case 'O': - dolong = TRUE; - /* FALL THROUGH */ - case 'x': case 'o': case 'u': - ch = *(++t); - *t = '\0'; - value = SvNV(arg); -#ifdef QUAD - if (doquad) - (void)sprintf(buf,s,(unsigned quad)value); - else -#endif - if (dolong) - (void)sprintf(xs,f,U_L(value)); - else - (void)sprintf(xs,f,U_I(value)); - xlen = strlen(xs); - break; - case 'E': case 'e': case 'f': case 'G': case 'g': - ch = *(++t); - *t = '\0'; - (void)sprintf(xs,f,SvNV(arg)); - xlen = strlen(xs); - break; - case 's': - ch = *(++t); - *t = '\0'; - xs = SvPV(arg); - xlen = arg->sv_cur; - if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0' - && xlen == sizeof(GP)) { - SV *tmpstr = NEWSV(24,0); - - gv_efullname(tmpstr, ((GV*)arg)); /* a gv value! */ - sprintf(tokenbuf,"*%s",tmpstr->sv_ptr); - /* reformat to non-binary */ - xs = tokenbuf; - xlen = strlen(tokenbuf); - sv_free(tmpstr); - } - if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */ - break; /* so handle simple cases */ - } - else if (f[1] == '-') { - char *mp = index(f, '.'); - int min = atoi(f+2); - - if (mp) { - int max = atoi(mp+1); - - if (xlen > max) - xlen = max; - } - if (xlen < min) - post = min - xlen; - break; - } - else if (isDIGIT(f[1])) { - char *mp = index(f, '.'); - int min = atoi(f+1); - - if (mp) { - int max = atoi(mp+1); - - if (xlen > max) - xlen = max; - } - if (xlen < min) - pre = min - xlen; - break; - } - strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */ - *t = ch; - (void)sprintf(buf,tokenbuf+64,xs); - xs = buf; - xlen = strlen(xs); - break; - } - /* end of switch, copy results */ - *t = ch; - SvGROW(sv, sv->sv_cur + (f - s) + xlen + 1 + pre + post); - sv_catpvn(sv, s, f - s); - if (pre) { - repeatcpy(sv->sv_ptr + sv->sv_cur, " ", 1, pre); - sv->sv_cur += pre; - } - sv_catpvn(sv, xs, xlen); - if (post) { - repeatcpy(sv->sv_ptr + sv->sv_cur, " ", 1, post); - sv->sv_cur += post; - } - s = t; - break; /* break from for loop */ - } - } - sv_catpvn(sv, s, t - s); - SvSETMAGIC(sv); -} - -void -do_vecset(mstr,sv) -SV *mstr; -SV *sv; -{ - struct lstring *lstr = (struct lstring*)sv; - register int offset; - register int size; - register unsigned char *s = (unsigned char*)mstr->sv_ptr; - register unsigned long lval = U_L(SvNV(sv)); - int mask; - - mstr->sv_rare = 0; - sv->sv_magic = Nullsv; - offset = lstr->lstr_offset; - size = lstr->lstr_len; - if (size < 8) { - mask = (1 << size) - 1; - size = offset & 7; - lval &= mask; - offset >>= 3; - s[offset] &= ~(mask << size); - s[offset] |= lval << size; - } - else { - if (size == 8) - s[offset] = lval & 255; - else if (size == 16) { - s[offset] = (lval >> 8) & 255; - s[offset+1] = lval & 255; - } - else if (size == 32) { - s[offset] = (lval >> 24) & 255; - s[offset+1] = (lval >> 16) & 255; - s[offset+2] = (lval >> 8) & 255; - s[offset+3] = lval & 255; - } - } -} - -void -do_chop(astr,sv) -register SV *astr; -register SV *sv; -{ - register char *tmps; - register int i; - AV *ary; - HV *hash; - HE *entry; - - if (!sv) - return; - if (sv->sv_state == SVs_AV) { - ary = (AV*)sv; - for (i = 0; i <= ary->av_fill; i++) - do_chop(astr,ary->av_array[i]); - return; - } - if (sv->sv_state == SVs_HV) { - hash = (HV*)sv; - (void)hv_iterinit(hash); - /*SUPPRESS 560*/ - while (entry = hv_iternext(hash)) - do_chop(astr,hv_iterval(hash,entry)); - return; - } - tmps = SvPV(sv); - if (tmps && sv->sv_cur) { - tmps += sv->sv_cur - 1; - sv_setpvn(astr,tmps,1); /* remember last char */ - *tmps = '\0'; /* wipe it out */ - sv->sv_cur = tmps - sv->sv_ptr; - sv->sv_nok = 0; - SvSETMAGIC(sv); - } - else - sv_setpvn(astr,"",0); -} - -void -do_vop(optype,sv,left,right) -int optype; -SV *sv; -SV *left; -SV *right; -{ -#ifdef LIBERAL - register long *dl; - register long *ll; - register long *rl; -#endif - register char *dc; - register char *lc = SvPV(left); - register char *rc = SvPV(right); - register int len; - - len = left->sv_cur; - if (len > right->sv_cur) - len = right->sv_cur; - if (sv->sv_cur > len) - sv->sv_cur = len; - else if (sv->sv_cur < len) { - SvGROW(sv,len); - (void)memzero(sv->sv_ptr + sv->sv_cur, len - sv->sv_cur); - sv->sv_cur = len; - } - sv->sv_pok = 1; - sv->sv_nok = 0; - dc = sv->sv_ptr; - if (!dc) { - sv_setpvn(sv,"",0); - dc = sv->sv_ptr; - } -#ifdef LIBERAL - if (len >= sizeof(long)*4 && - !((long)dc % sizeof(long)) && - !((long)lc % sizeof(long)) && - !((long)rc % sizeof(long))) /* It's almost always aligned... */ - { - int remainder = len % (sizeof(long)*4); - len /= (sizeof(long)*4); - - dl = (long*)dc; - ll = (long*)lc; - rl = (long*)rc; - - switch (optype) { - case OP_BIT_AND: - while (len--) { - *dl++ = *ll++ & *rl++; - *dl++ = *ll++ & *rl++; - *dl++ = *ll++ & *rl++; - *dl++ = *ll++ & *rl++; - } - break; - case OP_XOR: - while (len--) { - *dl++ = *ll++ ^ *rl++; - *dl++ = *ll++ ^ *rl++; - *dl++ = *ll++ ^ *rl++; - *dl++ = *ll++ ^ *rl++; - } - break; - case OP_BIT_OR: - while (len--) { - *dl++ = *ll++ | *rl++; - *dl++ = *ll++ | *rl++; - *dl++ = *ll++ | *rl++; - *dl++ = *ll++ | *rl++; - } - } - - dc = (char*)dl; - lc = (char*)ll; - rc = (char*)rl; - - len = remainder; - } -#endif - switch (optype) { - case OP_BIT_AND: - while (len--) - *dc++ = *lc++ & *rc++; - break; - case OP_XOR: - while (len--) - *dc++ = *lc++ ^ *rc++; - goto mop_up; - case OP_BIT_OR: - while (len--) - *dc++ = *lc++ | *rc++; - mop_up: - len = sv->sv_cur; - if (right->sv_cur > len) - sv_catpvn(sv,right->sv_ptr+len,right->sv_cur - len); - else if (left->sv_cur > len) - sv_catpvn(sv,left->sv_ptr+len,left->sv_cur - len); - break; - } -} @@ -31,15 +31,29 @@ static void dump(); void dump_all() { - register I32 i; - register HE *entry; - setlinebuf(stderr); if (main_root) dump_op(main_root); - for (i = 0; i <= 127; i++) { - for (entry = HvARRAY(defstash)[i]; entry; entry = entry->hent_next) - dump_sub((GV*)entry->hent_val); + dump_packsubs(defstash); +} + +void +dump_packsubs(stash) +HV* stash; +{ + U32 i; + HE *entry; + + for (i = 0; i <= HvMAX(stash); i++) { + for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) { + GV *gv = (GV*)entry->hent_val; + HV *hv; + if (GvCV(gv)) + dump_sub(gv); + if (*entry->hent_key == '_' && (hv = GvHV(gv)) && HvNAME(hv) && + hv != defstash) + dump_packsubs(hv); /* nested package */ + } } } @@ -50,7 +64,7 @@ GV* gv; SV *sv = sv_mortalcopy(&sv_undef); if (GvCV(gv)) { gv_fullname(sv,gv); - dump("\nSUB %s = ", SvPV(sv)); + dump("\nSUB %s = ", SvPVX(sv)); if (CvUSERSUB(GvCV(gv))) dump("(usersub 0x%x %d)\n", (long)CvUSERSUB(GvCV(gv)), @@ -170,7 +184,7 @@ register OP *op; if (cGVOP->op_gv) { tmpsv = NEWSV(0,0); gv_fullname(tmpsv,cGVOP->op_gv); - dump("GV = %s\n", SvPVn(tmpsv)); + dump("GV = %s\n", SvPV(tmpsv, na)); sv_free(tmpsv); } else @@ -228,7 +242,7 @@ register OP *op; case OP_PUSHRE: case OP_MATCH: case OP_SUBST: - dump_pm(op); + dump_pm((PMOP*)op); break; } if (op->op_flags & OPf_KIDS) { @@ -254,10 +268,10 @@ register GV *gv; dumplvl++; fprintf(stderr,"{\n"); gv_fullname(sv,gv); - dump("GV_NAME = %s", SvPV(sv)); + dump("GV_NAME = %s", SvPVX(sv)); if (gv != GvEGV(gv)) { gv_efullname(sv,GvEGV(gv)); - dump("-> %s", SvPV(sv)); + dump("-> %s", SvPVX(sv)); } dump("\n"); dumplvl--; diff --git a/emacs/cperl-mode b/emacs/cperl-mode new file mode 100644 index 0000000000..eb4aae2ab6 --- /dev/null +++ b/emacs/cperl-mode @@ -0,0 +1,710 @@ +Article 15212 of comp.lang.perl: +Path: netlabs!news.cerf.net!usc!howland.reston.ans.net!spool.mu.edu!umn.edu!news-feed-2.peachnet.edu!concert!duke!khera +From: khera@cs.duke.edu (Vivek Khera) +Newsgroups: comp.lang.perl +Subject: cperl-mode.el +Message-ID: <KHERA.93Oct21140851@thneed.cs.duke.edu> +Date: 21 Oct 93 18:08:51 GMT +Sender: news@duke.cs.duke.edu +Organization: Duke University CS Dept., Durham, NC +Lines: 694 +Nntp-Posting-Host: thneed.cs.duke.edu +X-Md4-Signature: 40dd9bccfb99794a9da2ee891b5bf557 +X-Md5-Signature: e4baa8cf00c94092ebf9712514e4696b + +Since I've received requests to do so, I'm posting the cperl-mode.el +file. This allows Emacs (both version 18 and 19) to do nice things +when editing Perl code. Indentation works well, and it doesn't get +confused like the perl-mode.el that comes with Emacs 19. + +Install this file as cperl-mode.el, and add the following to your +.emacs file: + +(autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t) + +This cperl-mode.el is not exactly the same as when it was originally +posted here. I made the following changes: perl-mode is an alias for +cperl-mode, and the major mode name is perl-mode, not cperl-mode. +This is so it is easier to use with Emacs 19. I suppose one could +install this as perl-mode.el and then not have to put the autoload +line in (for Emacs 19). + +Anyway, I'm not maintaining this, so don't send me bugs. + +--cut here-- +;;; From: olson@mcs.anl.gov (Bob Olson) +;;; Newsgroups: comp.lang.perl +;;; Subject: cperl-mode: Another perl mode for Gnuemacs +;;; Date: 14 Aug 91 15:20:01 GMT + +;; Perl code editing commands for Emacs +;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY. No author or distributor +;; accepts responsibility to anyone for the consequences of using it +;; or for whether it serves any particular purpose or works at all, +;; unless he says so in writing. Refer to the GNU Emacs General Public +;; License for full details. + +;; Everyone is granted permission to copy, modify and redistribute +;; GNU Emacs, but only under the conditions described in the +;; GNU Emacs General Public License. A copy of this license is +;; supposed to have been given to you along with GNU Emacs so you +;; can know your rights and responsibilities. It should be in a +;; file named COPYING. Among other things, the copyright notice +;; and this notice must be preserved on all copies. + + +(defvar cperl-mode-abbrev-table nil + "Abbrev table in use in Cperl-mode buffers.") +(define-abbrev-table 'cperl-mode-abbrev-table ()) + +(defvar cperl-mode-map () + "Keymap used in C mode.") +(if cperl-mode-map + () + (setq cperl-mode-map (make-sparse-keymap)) + (define-key cperl-mode-map "{" 'electric-cperl-brace) + (define-key cperl-mode-map "}" 'electric-cperl-brace) + (define-key cperl-mode-map ";" 'electric-cperl-semi) + (define-key cperl-mode-map ":" 'electric-cperl-terminator) + (define-key cperl-mode-map "\e\C-h" 'mark-cperl-function) + (define-key cperl-mode-map "\e\C-q" 'indent-cperl-exp) + (define-key cperl-mode-map "\177" 'backward-delete-char-untabify) + (define-key cperl-mode-map "\t" 'cperl-indent-command)) + +(autoload 'cperl-macro-expand "cmacexp" + "Display the result of expanding all C macros occurring in the region. +The expansion is entirely correct because it uses the C preprocessor." + t) + +(defvar cperl-mode-syntax-table nil + "Syntax table in use in Cperl-mode buffers.") + +(if cperl-mode-syntax-table + () + (setq cperl-mode-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\\ "\\" cperl-mode-syntax-table) + (modify-syntax-entry ?/ ". 14" cperl-mode-syntax-table) + (modify-syntax-entry ?* ". 23" cperl-mode-syntax-table) + (modify-syntax-entry ?+ "." cperl-mode-syntax-table) + (modify-syntax-entry ?- "." cperl-mode-syntax-table) + (modify-syntax-entry ?= "." cperl-mode-syntax-table) + (modify-syntax-entry ?% "." cperl-mode-syntax-table) + (modify-syntax-entry ?< "." cperl-mode-syntax-table) + (modify-syntax-entry ?> "." cperl-mode-syntax-table) + (modify-syntax-entry ?& "." cperl-mode-syntax-table) + (modify-syntax-entry ?| "." cperl-mode-syntax-table)) + + +(defvar cperl-indent-level 2 + "*Indentation of C statements with respect to containing block.") +(defvar cperl-brace-imaginary-offset 0 + "*Imagined indentation of a C open brace that actually follows a statement.") +(defvar cperl-brace-offset 0 + "*Extra indentation for braces, compared with other text in same context.") +(defvar cperl-argdecl-indent 5 + "*Indentation level of declarations of C function arguments.") +(defvar cperl-label-offset -2 + "*Offset of C label lines and case statements relative to usual indentation.") +(defvar cperl-continued-statement-offset 2 + "*Extra indent for lines not starting new statements.") +(defvar cperl-continued-brace-offset 0 + "*Extra indent for substatements that start with open-braces. +This is in addition to cperl-continued-statement-offset.") + +(defvar cperl-auto-newline nil + "*Non-nil means automatically newline before and after braces, +and after colons and semicolons, inserted in C code.") + +(defvar cperl-tab-always-indent t + "*Non-nil means TAB in C mode should always reindent the current line, +regardless of where in the line point is when the TAB command is used.") + +;; provide an alias for working with emacs 19. the perl-mode that comes +;; with it is really bad, and this lets us seamlessly replace it. +(fset 'perl-mode 'cperl-mode) +(defun cperl-mode () + "Major mode for editing C code. +Expression and list commands understand all C brackets. +Tab indents for C code. +Comments are delimited with /* ... */. +Paragraphs are separated by blank lines only. +Delete converts tabs to spaces as it moves back. +\\{cperl-mode-map} +Variables controlling indentation style: + cperl-tab-always-indent + Non-nil means TAB in C mode should always reindent the current line, + regardless of where in the line point is when the TAB command is used. + cperl-auto-newline + Non-nil means automatically newline before and after braces, + and after colons and semicolons, inserted in C code. + cperl-indent-level + Indentation of C statements within surrounding block. + The surrounding block's indentation is the indentation + of the line on which the open-brace appears. + cperl-continued-statement-offset + Extra indentation given to a substatement, such as the + then-clause of an if or body of a while. + cperl-continued-brace-offset + Extra indentation given to a brace that starts a substatement. + This is in addition to cperl-continued-statement-offset. + cperl-brace-offset + Extra indentation for line if it starts with an open brace. + cperl-brace-imaginary-offset + An open brace following other text is treated as if it were + this far to the right of the start of its line. + cperl-argdecl-indent + Indentation level of declarations of C function arguments. + cperl-label-offset + Extra indentation for line that is a label, or case or default. + +Settings for K&R and BSD indentation styles are + cperl-indent-level 5 8 + cperl-continued-statement-offset 5 8 + cperl-brace-offset -5 -8 + cperl-argdecl-indent 0 8 + cperl-label-offset -5 -8 + +Turning on C mode calls the value of the variable cperl-mode-hook with no args, +if that value is non-nil." + (interactive) + (kill-all-local-variables) + (use-local-map cperl-mode-map) + (setq major-mode 'perl-mode) + (setq mode-name "CPerl") + (setq local-abbrev-table cperl-mode-abbrev-table) + (set-syntax-table cperl-mode-syntax-table) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^$\\|" page-delimiter)) + (make-local-variable 'paragraph-separate) + (setq paragraph-separate paragraph-start) + (make-local-variable 'paragraph-ignore-fill-prefix) + (setq paragraph-ignore-fill-prefix t) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'cperl-indent-line) + (make-local-variable 'require-final-newline) + (setq require-final-newline t) + (make-local-variable 'comment-start) + (setq comment-start "# ") + (make-local-variable 'comment-end) + (setq comment-end "") + (make-local-variable 'comment-column) + (setq comment-column 32) + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "# *") + (make-local-variable 'comment-indent-hook) + (setq comment-indent-hook 'cperl-comment-indent) + (make-local-variable 'parse-sexp-ignore-comments) + (setq parse-sexp-ignore-comments t) + (run-hooks 'cperl-mode-hook)) + +;; This is used by indent-for-comment +;; to decide how much to indent a comment in C code +;; based on its context. +(defun cperl-comment-indent () + (if (looking-at "^#") + 0 ;Existing comment at bol stays there. + (save-excursion + (skip-chars-backward " \t") + (max (1+ (current-column)) ;Else indent at comment column + comment-column)))) ; except leave at least one space. + +(defun electric-cperl-brace (arg) + "Insert character and correct line's indentation." + (interactive "P") + (let (insertpos) + (if (and (not arg) + (eolp) + (or (save-excursion + (skip-chars-backward " \t") + (bolp)) + (if cperl-auto-newline (progn (cperl-indent-line) (newline) t) nil))) + (progn + (insert last-command-char) + (cperl-indent-line) + (if cperl-auto-newline + (progn + (newline) + ;; (newline) may have done auto-fill + (setq insertpos (- (point) 2)) + (cperl-indent-line))) + (save-excursion + (if insertpos (goto-char (1+ insertpos))) + (delete-char -1)))) + (if insertpos + (save-excursion + (goto-char insertpos) + (self-insert-command (prefix-numeric-value arg))) + (self-insert-command (prefix-numeric-value arg))))) + +(defun electric-cperl-semi (arg) + "Insert character and correct line's indentation." + (interactive "P") + (if cperl-auto-newline + (electric-cperl-terminator arg) + (self-insert-command (prefix-numeric-value arg)))) + +(defun electric-cperl-terminator (arg) + "Insert character and correct line's indentation." + (interactive "P") + (let (insertpos (end (point))) + (if (and (not arg) (eolp) + (not (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (or (= (following-char) ?#) + ;; Colon is special only after a label, or case .... + ;; So quickly rule out most other uses of colon + ;; and do no indentation for them. + (and (eq last-command-char ?:) + (not (looking-at "case[ \t]")) + (save-excursion + (forward-word 1) + (skip-chars-forward " \t") + (< (point) end))) + (progn + (beginning-of-defun) + (let ((pps (parse-partial-sexp (point) end))) + (or (nth 3 pps) (nth 4 pps) (nth 5 pps)))))))) + (progn + (insert last-command-char) + (cperl-indent-line) + (and cperl-auto-newline + (not (cperl-inside-parens-p)) + (progn + (newline) + (setq insertpos (- (point) 2)) + (cperl-indent-line))) + (save-excursion + (if insertpos (goto-char (1+ insertpos))) + (delete-char -1)))) + (if insertpos + (save-excursion + (goto-char insertpos) + (self-insert-command (prefix-numeric-value arg))) + (self-insert-command (prefix-numeric-value arg))))) + +(defun cperl-inside-parens-p () + (condition-case () + (save-excursion + (save-restriction + (narrow-to-region (point) + (progn (beginning-of-defun) (point))) + (goto-char (point-max)) + (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\())) + (error nil))) + +(defun cperl-indent-command (&optional whole-exp) + (interactive "P") + "Indent current line as C code, or in some cases insert a tab character. +If cperl-tab-always-indent is non-nil (the default), always indent current line. +Otherwise, indent the current line only if point is at the left margin +or in the line's indentation; otherwise insert a tab. + +A numeric argument, regardless of its value, +means indent rigidly all the lines of the expression starting after point +so that this line becomes properly indented. +The relative indentation among the lines of the expression are preserved." + (if whole-exp + ;; If arg, always indent this line as C + ;; and shift remaining lines of expression the same amount. + (let ((shift-amt (cperl-indent-line)) + beg end) + (save-excursion + (if cperl-tab-always-indent + (beginning-of-line)) + (setq beg (point)) + (forward-sexp 1) + (setq end (point)) + (goto-char beg) + (forward-line 1) + (setq beg (point))) + (if (> end beg) + (indent-code-rigidly beg end shift-amt "#"))) + (if (and (not cperl-tab-always-indent) + (save-excursion + (skip-chars-backward " \t") + (not (bolp)))) + (insert-tab) + (cperl-indent-line)))) + +(defun cperl-indent-line () + "Indent current line as C code. +Return the amount the indentation changed by." + (let ((indent (calculate-cperl-indent nil)) + beg shift-amt + (case-fold-search nil) + (pos (- (point-max) (point)))) + (beginning-of-line) + (setq beg (point)) + (cond ((eq indent nil) + (setq indent (current-indentation))) + ((eq indent t) + (setq indent (calculate-cperl-indent-within-comment))) + ((looking-at "[ \t]*#") + (setq indent 0)) + (t + (skip-chars-forward " \t") + (if (listp indent) (setq indent (car indent))) + (cond ((or (looking-at "case[ \t]") + (and (looking-at "[A-Za-z]") + (save-excursion + (forward-sexp 1) + (looking-at ":")))) + (setq indent (max 1 (+ indent cperl-label-offset)))) + ((and (looking-at "else\\b") + (not (looking-at "else\\s_"))) + (setq indent (save-excursion + (cperl-backward-to-start-of-if) + (current-indentation)))) + ((= (following-char) ?}) + (setq indent (- indent cperl-indent-level))) + ((= (following-char) ?{) + (setq indent (+ indent cperl-brace-offset)))))) + (skip-chars-forward " \t") + (setq shift-amt (- indent (current-column))) + (if (zerop shift-amt) + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))) + (delete-region beg (point)) + (indent-to indent) + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos)))) + shift-amt)) + +(defun calculate-cperl-indent (&optional parse-start) + "Return appropriate indentation for current line as C code. +In usual case returns an integer: the column to indent to. +Returns nil if line starts inside a string, t if in a comment." + (save-excursion + (beginning-of-line) + (let ((indent-point (point)) + (case-fold-search nil) + state + containing-sexp) + (if parse-start + (goto-char parse-start) + (beginning-of-defun)) + (while (< (point) indent-point) + (setq parse-start (point)) + (setq state (parse-partial-sexp (point) indent-point 0)) + (setq containing-sexp (car (cdr state)))) + (cond ((or (nth 3 state) (nth 4 state)) + ;; return nil or t if should not change this line + (nth 4 state)) + ((null containing-sexp) + ;; Line is at top level. May be data or function definition, + ;; or may be function argument declaration. + ;; Indent like the previous top level line + ;; unless that ends in a closeparen without semicolon, + ;; in which case this line is the first argument decl. + (goto-char indent-point) + (skip-chars-forward " \t") + (if (= (following-char) ?{) + 0 ; Unless it starts a function body + (cperl-backward-to-noncomment (or parse-start (point-min))) + ;; Look at previous line that's at column 0 + ;; to determine whether we are in top-level decls + ;; or function's arg decls. Set basic-indent accordinglu. + (let ((basic-indent + (save-excursion + (re-search-backward "^[^ \^L\t\n#]" nil 'move) + (if (and (looking-at "\\sw\\|\\s_") + (looking-at ".*(") + (progn + (goto-char (1- (match-end 0))) + (forward-sexp 1) + (and (< (point) indent-point) + (not (memq (following-char) + '(?\, ?\;)))))) + cperl-argdecl-indent 0)))) + ;; Now add a little if this is a continuation line. + (+ basic-indent (if (or (bobp) + (memq (preceding-char) '(?\) ?\; ?\}))) + 0 cperl-continued-statement-offset))))) + ((/= (char-after containing-sexp) ?{) + ;; line is expression, not statement: + ;; indent to just after the surrounding open. + (goto-char (1+ containing-sexp)) + (current-column)) + (t + ;; Statement level. Is it a continuation or a new statement? + ;; Find previous non-comment character. + (goto-char indent-point) + (cperl-backward-to-noncomment containing-sexp) + ;; Back up over label lines, since they don't + ;; affect whether our line is a continuation. + (while (or (eq (preceding-char) ?\,) + (and (eq (preceding-char) ?:) + (or (eq (char-after (- (point) 2)) ?\') + (memq (char-syntax (char-after (- (point) 2))) + '(?w ?_))))) + (if (eq (preceding-char) ?\,) + (cperl-backward-to-start-of-continued-exp containing-sexp)) + (beginning-of-line) + (cperl-backward-to-noncomment containing-sexp)) + ;; Now we get the answer. + (if (not (memq (preceding-char) '(nil ?\, ?\; ?\} ?\{))) + ;; This line is continuation of preceding line's statement; + ;; indent cperl-continued-statement-offset more than the + ;; previous line of the statement. + (progn + (cperl-backward-to-start-of-continued-exp containing-sexp) + (+ cperl-continued-statement-offset (current-column) + (if (save-excursion (goto-char indent-point) + (skip-chars-forward " \t") + (eq (following-char) ?{)) + cperl-continued-brace-offset 0))) + ;; This line starts a new statement. + ;; Position following last unclosed open. + (goto-char containing-sexp) + ;; Is line first statement after an open-brace? + (or + ;; If no, find that first statement and indent like it. + (save-excursion + (forward-char 1) + (let ((colon-line-end 0)) + (while (progn (skip-chars-forward " \t\n") + (looking-at "#\\|/\\*\\|case[ \t\n].*:\\|[a-zA-Z0-9_$]*:")) + ;; Skip over comments and labels following openbrace. + (cond ((= (following-char) ?\#) + (forward-line 1)) + ((= (following-char) ?\/) + (forward-char 2) + (search-forward "*/" nil 'move)) + ;; case or label: + (t + (save-excursion (end-of-line) + (setq colon-line-end (point))) + (search-forward ":")))) + ;; The first following code counts + ;; if it is before the line we want to indent. + (and (< (point) indent-point) + (if (> colon-line-end (point)) + (- (current-indentation) cperl-label-offset) + (current-column))))) + ;; If no previous statement, + ;; indent it relative to line brace is on. + ;; For open brace in column zero, don't let statement + ;; start there too. If cperl-indent-level is zero, + ;; use cperl-brace-offset + cperl-continued-statement-offset instead. + ;; For open-braces not the first thing in a line, + ;; add in cperl-brace-imaginary-offset. + (+ (if (and (bolp) (zerop cperl-indent-level)) + (+ cperl-brace-offset cperl-continued-statement-offset) + cperl-indent-level) + ;; Move back over whitespace before the openbrace. + ;; If openbrace is not first nonwhite thing on the line, + ;; add the cperl-brace-imaginary-offset. + (progn (skip-chars-backward " \t") + (if (bolp) 0 cperl-brace-imaginary-offset)) + ;; If the openbrace is preceded by a parenthesized exp, + ;; move to the beginning of that; + ;; possibly a different line + (progn + (if (eq (preceding-char) ?\)) + (forward-sexp -1)) + ;; Get initial indentation of the line we are on. + (current-indentation)))))))))) + +(defun calculate-cperl-indent-within-comment () + "Return the indentation amount for line, assuming that +the current line is to be regarded as part of a block comment." + (let (end star-start) + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (setq star-start (= (following-char) ?\*)) + (skip-chars-backward " \t\n") + (setq end (point)) + (beginning-of-line) + (skip-chars-forward " \t") + (and (re-search-forward "/\\*[ \t]*" end t) + star-start + (goto-char (1+ (match-beginning 0)))) + (current-column)))) + + +(defun cperl-backward-to-noncomment (lim) + (let (opoint stop) + (while (not stop) + (skip-chars-backward " \t\n\f" lim) + (setq opoint (point)) + (if (and (>= (point) (+ 2 lim)) + (save-excursion + (forward-char -2) + (looking-at "\\*/"))) + (search-backward "/*" lim 'move) + (beginning-of-line) + (skip-chars-forward " \t") + (setq stop (or (not (looking-at "#")) (<= (point) lim))) + (if stop (goto-char opoint) + (beginning-of-line)))))) + +(defun cperl-backward-to-start-of-continued-exp (lim) + (if (= (preceding-char) ?\)) + (forward-sexp -1)) + (beginning-of-line) + (if (<= (point) lim) + (goto-char (1+ lim))) + (skip-chars-forward " \t")) + +(defun cperl-backward-to-start-of-if (&optional limit) + "Move to the start of the last ``unbalanced'' if." + (or limit (setq limit (save-excursion (beginning-of-defun) (point)))) + (let ((if-level 1) + (case-fold-search nil)) + (while (not (zerop if-level)) + (backward-sexp 1) + (cond ((looking-at "else\\b") + (setq if-level (1+ if-level))) + ((looking-at "if\\b") + (setq if-level (1- if-level))) + ((< (point) limit) + (setq if-level 0) + (goto-char limit)))))) + + +(defun mark-cperl-function () + "Put mark at end of C function, point at beginning." + (interactive) + (push-mark (point)) + (end-of-defun) + (push-mark (point)) + (beginning-of-defun) + (backward-paragraph)) + +(defun indent-cperl-exp () + "Indent each line of the C grouping following point." + (interactive) + (let ((indent-stack (list nil)) + (contain-stack (list (point))) + (case-fold-search nil) + restart outer-loop-done inner-loop-done state ostate + this-indent last-sexp + at-else at-brace + (opoint (point)) + (next-depth 0)) + (save-excursion + (forward-sexp 1)) + (save-excursion + (setq outer-loop-done nil) + (while (and (not (eobp)) (not outer-loop-done)) + (setq last-depth next-depth) + ;; Compute how depth changes over this line + ;; plus enough other lines to get to one that + ;; does not end inside a comment or string. + ;; Meanwhile, do appropriate indentation on comment lines. + (setq innerloop-done nil) + (while (and (not innerloop-done) + (not (and (eobp) (setq outer-loop-done t)))) + (setq ostate state) + (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) + nil nil state)) + (setq next-depth (car state)) + (if (and (car (cdr (cdr state))) + (>= (car (cdr (cdr state))) 0)) + (setq last-sexp (car (cdr (cdr state))))) + (if (or (nth 4 ostate)) + (cperl-indent-line)) + (if (or (nth 3 state)) + (forward-line 1) + (setq innerloop-done t))) + (if (<= next-depth 0) + (setq outer-loop-done t)) + (if outer-loop-done + nil + ;; If this line had ..))) (((.. in it, pop out of the levels + ;; that ended anywhere in this line, even if the final depth + ;; doesn't indicate that they ended. + (while (> last-depth (nth 6 state)) + (setq indent-stack (cdr indent-stack) + contain-stack (cdr contain-stack) + last-depth (1- last-depth))) + (if (/= last-depth next-depth) + (setq last-sexp nil)) + ;; Add levels for any parens that were started in this line. + (while (< last-depth next-depth) + (setq indent-stack (cons nil indent-stack) + contain-stack (cons nil contain-stack) + last-depth (1+ last-depth))) + (if (null (car contain-stack)) + (setcar contain-stack (or (car (cdr state)) + (save-excursion (forward-sexp -1) + (point))))) + (forward-line 1) + (skip-chars-forward " \t") + (if (eolp) + nil + (if (and (car indent-stack) + (>= (car indent-stack) 0)) + ;; Line is on an existing nesting level. + ;; Lines inside parens are handled specially. + (if (/= (char-after (car contain-stack)) ?{) + (setq this-indent (car indent-stack)) + ;; Line is at statement level. + ;; Is it a new statement? Is it an else? + ;; Find last non-comment character before this line + (save-excursion + (setq at-else (looking-at "else\\W")) + (setq at-brace (= (following-char) ?{)) + (cperl-backward-to-noncomment opoint) + (if (not (memq (preceding-char) '(nil ?\, ?\; ?} ?: ?{))) + ;; Preceding line did not end in comma or semi; + ;; indent this line cperl-continued-statement-offset + ;; more than previous. + (progn + (cperl-backward-to-start-of-continued-exp (car contain-stack)) + (setq this-indent + (+ cperl-continued-statement-offset (current-column) + (if at-brace cperl-continued-brace-offset 0)))) + ;; Preceding line ended in comma or semi; + ;; use the standard indent for this level. + (if at-else + (progn (cperl-backward-to-start-of-if opoint) + (setq this-indent (current-indentation))) + (setq this-indent (car indent-stack)))))) + ;; Just started a new nesting level. + ;; Compute the standard indent for this level. + (let ((val (calculate-cperl-indent + (if (car indent-stack) + (- (car indent-stack)))))) + (setcar indent-stack + (setq this-indent val)))) + ;; Adjust line indentation according to its contents + (if (or (looking-at "case[ \t]") + (and (looking-at "[A-Za-z]") + (save-excursion + (forward-sexp 1) + (looking-at ":")))) + (setq this-indent (max 1 (+ this-indent cperl-label-offset)))) + (if (= (following-char) ?}) + (setq this-indent (- this-indent cperl-indent-level))) + (if (= (following-char) ?{) + (setq this-indent (+ this-indent cperl-brace-offset))) + ;; Put chosen indentation into effect. + (or (= (current-column) this-indent) + (= (following-char) ?\#) + (progn + (delete-region (point) (progn (beginning-of-line) (point))) + (indent-to this-indent))) + ;; Indent any comment following the text. + (or (looking-at comment-start-skip) + (if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t) + (progn (indent-for-comment) (beginning-of-line))))))))) +; (message "Indenting C expression...done") + ) +--cut here-- +-- +=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= +Vivek Khera, Gradual Student/Systems Guy Department of Computer Science +Internet: khera@cs.duke.edu Box 90129 + RIPEM/PGP/MIME spoken here Durham, NC 27708-0129 (919)660-6528 + + diff --git a/emacs/emacs19 b/emacs/emacs19 new file mode 100644 index 0000000000..c3bb070a64 --- /dev/null +++ b/emacs/emacs19 @@ -0,0 +1,312 @@ +Article 15041 of comp.lang.perl: +Path: netlabs!news.cerf.net!usc!sol.ctr.columbia.edu!news.kei.com!bloom-beacon.mit.edu!paperboy.osf.org!meissner +From: meissner@osf.org (Michael Meissner) +Newsgroups: comp.lang.perl +Subject: Re: question on using perldb.el with emacs +Date: 17 Oct 1993 21:10:21 GMT +Organization: Open Software Foundation +Lines: 297 +Message-ID: <MEISSNER.93Oct17171021@pasta.osf.org> +References: <BSHAW.93Oct17143524@bobasun.spdc.ti.com> +NNTP-Posting-Host: pasta.osf.org +In-reply-to: bshaw@bobasun.spdc.ti.com's message of Sun, 17 Oct 1993 19:35:24 GMT + +In article <BSHAW.93Oct17143524@bobasun.spdc.ti.com> bshaw@bobasun.spdc.ti.com +(Bob Shaw) writes: + +| Hi folks +| +| Say, I'm trying to use perldb with emacs. I can invoke perldb +| within emacs ok and get the window *perldb-foo* but when it asks +| for "additional command line arguments" , no matter what I give it +| I get the error message Symbol's function definition is void: make- +| shell. +| +| The debugger , by itself, works fine but wanted to try out perldb in +| emacs. + +This is a symptom of using Emacs 19.xx with perldb.el which was originally made +for emacs version 18.xx. You can either install the emacs19 replacement for +perldb that hooks it in with GUD (grand unified debugger), or apply the patches +that I picked off of the net (I use the perldb replacement that uses GUD +myself): + +#!/bin/sh +# This is a shell archive (produced by shar 3.49) +# To extract the files from this archive, save it to a file, remove +# everything above the "!/bin/sh" line above, and type "sh file_name". +# +# made 10/17/1993 21:07 UTC by meissner@pasta.osf.org +# Source directory /usr/users/meissner/elisp +# +# existing files will NOT be overwritten unless -c is specified +# +# This shar contains: +# length mode name +# ------ ---------- ------------------------------------------ +# 4761 -rw-r--r-- emacs19-perldb.el +# 3845 -rw-rw-r-- emacs19-perldb.patches +# +# ============= emacs19-perldb.el ============== +if test -f 'emacs19-perldb.el' -a X"$1" != X"-c"; then + echo 'x - skipping emacs19-perldb.el (File already exists)' +else +echo 'x - extracting emacs19-perldb.el (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'emacs19-perldb.el' && +X;; Author : Stephane Boucher +X;; Note : This is an add on for gud (Part of GNU Emacs 19). It is +X;; derived from the gdb section that is part of gud. +X +X;; Copyright (C) 1993 Stephane Boucher. +X +X;; Perldb is free software; you can redistribute it and/or modify +X;; it under the terms of the GNU General Public License as published by +X;; the Free Software Foundation; either version 2, or (at your option) +X;; any later version. +X +X;; Perldb Emacs is distributed in the hope that it will be useful, +X;; but WITHOUT ANY WARRANTY; without even the implied warranty of +X;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +X;; GNU General Public License for more details. +X +X;; You should have received a copy of the GNU General Public License +X;; along with GNU Emacs; see the file COPYING. If not, write to +X;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +X +X(require 'gud) +X +X;; ====================================================================== +X;; perldb functions +X +X;;; History of argument lists passed to perldb. +X(defvar gud-perldb-history nil) +X +X(defun gud-perldb-massage-args (file args) +X (cons "-d" (cons file (cons "-emacs" args)))) +X +X;; There's no guarantee that Emacs will hand the filter the entire +X;; marker at once; it could be broken up across several strings. We +X;; might even receive a big chunk with several markers in it. If we +X;; receive a chunk of text which looks like it might contain the +X;; beginning of a marker, we save it here between calls to the +X;; filter. +X(defvar gud-perldb-marker-acc "") +X +X(defun gud-perldb-marker-filter (string) +X (save-match-data +X (setq gud-perldb-marker-acc (concat gud-perldb-marker-acc string)) +X (let ((output "")) +X +X ;; Process all the complete markers in this chunk. +X (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" +X gud-perldb-marker-acc) +X (setq +X +X ;; Extract the frame position from the marker. +X gud-last-frame +X (cons (substring gud-perldb-marker-acc (match-beginning 1) (match-end 1)) +X (string-to-int (substring gud-perldb-marker-acc +X (match-beginning 2) +X (match-end 2)))) +X +X ;; Append any text before the marker to the output we're going +X ;; to return - we don't include the marker in this text. +X output (concat output +X (substring gud-perldb-marker-acc 0 (match-beginning 0))) +X +X ;; Set the accumulator to the remaining text. +X gud-perldb-marker-acc (substring gud-perldb-marker-acc (match-end 0)))) +X +X ;; Does the remaining text look like it might end with the +X ;; beginning of another marker? If it does, then keep it in +X ;; gud-perldb-marker-acc until we receive the rest of it. Since we +X ;; know the full marker regexp above failed, it's pretty simple to +X ;; test for marker starts. +X (if (string-match "^\032.*\\'" gud-perldb-marker-acc) +X (progn +X ;; Everything before the potential marker start can be output. +X (setq output (concat output (substring gud-perldb-marker-acc +X 0 (match-beginning 0)))) +X +X ;; Everything after, we save, to combine with later input. +X (setq gud-perldb-marker-acc +X (substring gud-perldb-marker-acc (match-beginning 0)))) +X +X (setq output (concat output gud-perldb-marker-acc) +X gud-perldb-marker-acc "")) +X +X output))) +X +X(defun gud-perldb-find-file (f) +X (find-file-noselect f)) +X +X;;;###autoload +X(defun perldb (command-line) +X "Run perldb on program FILE in buffer *gud-FILE*. +XThe directory containing FILE becomes the initial working directory +Xand source-file directory for your debugger." +X (interactive +X (list (read-from-minibuffer "Run perldb (like this): " +X (if (consp gud-perldb-history) +X (car gud-perldb-history) +X "perl ") +X nil nil +X '(gud-perldb-history . 1)))) +X (gud-overload-functions '((gud-massage-args . gud-perldb-massage-args) +X (gud-marker-filter . gud-perldb-marker-filter) +X (gud-find-file . gud-perldb-find-file) +X )) +X +X (gud-common-init command-line) +X +X (gud-def gud-break "b %l" "\C-b" "Set breakpoint at current line.") +X (gud-def gud-remove "d %l" "\C-d" "Remove breakpoint at current line") +X (gud-def gud-step "s" "\C-s" "Step one source line with display.") +X (gud-def gud-next "n" "\C-n" "Step one line (skip functions).") +X (gud-def gud-cont "c" "\C-r" "Continue with display.") +X; (gud-def gud-finish "finish" "\C-f" "Finish executing current function.") +X; (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") +X; (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") +X (gud-def gud-print "%e" "\C-p" "Evaluate perl expression at point.") +X +X (setq comint-prompt-regexp "^ DB<[0-9]+> ") +X (run-hooks 'perldb-mode-hook) +X ) +SHAR_EOF +chmod 0644 emacs19-perldb.el || +echo 'restore of emacs19-perldb.el failed' +Wc_c="`wc -c < 'emacs19-perldb.el'`" +test 4761 -eq "$Wc_c" || + echo 'emacs19-perldb.el: original size 4761, current size' "$Wc_c" +fi +# ============= emacs19-perldb.patches ============== +if test -f 'emacs19-perldb.patches' -a X"$1" != X"-c"; then + echo 'x - skipping emacs19-perldb.patches (File already exists)' +else +echo 'x - extracting emacs19-perldb.patches (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'emacs19-perldb.patches' && +XFrom dmm0t@rincewind.mech.virginia.edu Fri Jul 16 23:17:10 1993 +XPath: paperboy.osf.org!bloom-beacon.mit.edu!biosci!uwm.edu!ux1.cso.uiuc.edu!howland.reston.ans.net!darwin.sura.net!news-feed-2.peachnet.edu!concert!uvaarpa!murdoch!rincewind.mech.virginia.edu!dmm0t +XFrom: dmm0t@rincewind.mech.virginia.edu (David Meyer) +XNewsgroups: gnu.emacs.sources +XSubject: patches to perldb.el for emacs-19 +XMessage-ID: <CA7uq9.30J@murdoch.acc.Virginia.EDU> +XDate: 15 Jul 93 17:18:07 GMT +XSender: usenet@murdoch.acc.Virginia.EDU +XOrganization: University of Virginia +XLines: 97 +X +X +XHere are my patches to perldb.el (the perl debugger mode that comes +Xwith perl 4.0xx). Basically, all I've done is to hack perldb.el to +Xuse comint.el stuff rather than the old shell.el stuff (i.e. change +Xshell-mode-map to comint-mode-map). +X +XI've been using my patched version without problem, but if anyone sees +Xsomething I've missed, please post or send e-mail. +X +X Thanks, +X Dave +X +X +X*** /Users/dmm0t/perldb.el Thu Jul 15 13:06:59 1993 +X--- perldb.el Tue Jul 6 22:24:41 1993 +X*************** +X*** 65,71 **** +X +X (if perldb-mode-map +X nil +X! (setq perldb-mode-map (copy-keymap shell-mode-map)) +X (define-key perldb-mode-map "\C-l" 'perldb-refresh)) +X +X (define-key ctl-x-map " " 'perldb-break) +X--- 65,71 ---- +X +X (if perldb-mode-map +X nil +X! (setq perldb-mode-map (copy-keymap comint-mode-map)) +X (define-key perldb-mode-map "\C-l" 'perldb-refresh)) +X +X (define-key ctl-x-map " " 'perldb-break) +X*************** +X*** 122,131 **** +X (setq mode-name "Inferior Perl") +X (setq mode-line-process '(": %s")) +X (use-local-map perldb-mode-map) +X! (make-local-variable 'last-input-start) +X! (setq last-input-start (make-marker)) +X! (make-local-variable 'last-input-end) +X! (setq last-input-end (make-marker)) +X (make-local-variable 'perldb-last-frame) +X (setq perldb-last-frame nil) +X (make-local-variable 'perldb-last-frame-displayed-p) +X--- 122,131 ---- +X (setq mode-name "Inferior Perl") +X (setq mode-line-process '(": %s")) +X (use-local-map perldb-mode-map) +X! (make-local-variable 'comint-last-input-start) +X! (setq comint-last-input-start (make-marker)) +X! (make-local-variable 'comint-last-input-end) +X! (setq comint-last-input-end (make-marker)) +X (make-local-variable 'perldb-last-frame) +X (setq perldb-last-frame nil) +X (make-local-variable 'perldb-last-frame-displayed-p) +X*************** +X*** 134,142 **** +X (setq perldb-delete-prompt-marker nil) +X (make-local-variable 'perldb-filter-accumulator) +X (setq perldb-filter-accumulator nil) +X! (make-local-variable 'shell-prompt-pattern) +X! (setq shell-prompt-pattern perldb-prompt-pattern) +X! (run-hooks 'shell-mode-hook 'perldb-mode-hook)) +X +X (defvar current-perldb-buffer nil) +X +X--- 134,142 ---- +X (setq perldb-delete-prompt-marker nil) +X (make-local-variable 'perldb-filter-accumulator) +X (setq perldb-filter-accumulator nil) +X! (make-local-variable 'comint-prompt-regexp) +X! (setq comint-prompt-regexp perldb-prompt-pattern) +X! (run-hooks 'comint-mode-hook 'perldb-mode-hook)) +X +X (defvar current-perldb-buffer nil) +X +X*************** +X*** 189,195 **** +X (setq default-directory dir) +X (or (bolp) (newline)) +X (insert "Current directory is " default-directory "\n") +X! (apply 'make-shell +X (concat "perldb-" file) perldb-command-name nil "-d" path "-emacs" +X (parse-args args)) +X (perldb-mode) +X--- 189,195 ---- +X (setq default-directory dir) +X (or (bolp) (newline)) +X (insert "Current directory is " default-directory "\n") +X! (apply 'make-comint +X (concat "perldb-" file) perldb-command-name nil "-d" path "-emacs" +X (parse-args args)) +X (perldb-mode) +X-- +XDavid M. Meyer Mechanical & Aerospace Engineering +Xdmm0t@rincewind.mech.virginia.edu University of Virginia +XNeXTmail ok +X +SHAR_EOF +chmod 0664 emacs19-perldb.patches || +echo 'restore of emacs19-perldb.patches failed' +Wc_c="`wc -c < 'emacs19-perldb.patches'`" +test 3845 -eq "$Wc_c" || + echo 'emacs19-perldb.patches: original size 3845, current size' "$Wc_c" +fi +exit 0 + +-- +Michael Meissner email: meissner@osf.org phone: 617-621-8861 +Open Software Foundation, 11 Cambridge Center, Cambridge, MA, 02142 + +Old hackers never die, their bugs just increase. + + @@ -2,18 +2,25 @@ /* (Doing namespace management portably in C is really gross.) */ -#ifdef EMBEDDED +#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 @@ -26,33 +33,58 @@ #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 @@ -61,6 +93,7 @@ #define regmyendp PERLregmyendp #define regmyp_size PERLregmyp_size #define regmystartp PERLregmystartp +#define regnarrate PERLregnarrate #define regnpar PERLregnpar #define regparse PERLregparse #define regprecomp PERLregprecomp @@ -71,9 +104,25 @@ #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 @@ -83,9 +132,731 @@ #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 -/* interpreter specific variables */ +#endif /* EMBEDDED */ + +/* Put interpreter specific variables into a struct? */ + +#ifdef MULTIPLICITY #define Argv (curinterp->IArgv) #define Cmd (curinterp->ICmd) @@ -117,7 +888,6 @@ #define cxstack_ix (curinterp->Icxstack_ix) #define cxstack_max (curinterp->Icxstack_max) #define dbargs (curinterp->Idbargs) -#define dbmrefcnt (curinterp->Idbmrefcnt) #define debdelim (curinterp->Idebdelim) #define debname (curinterp->Idebname) #define debstash (curinterp->Idebstash) @@ -223,8 +993,8 @@ #define statusvalue (curinterp->Istatusvalue) #define stdingv (curinterp->Istdingv) #define strchop (curinterp->Istrchop) -#define taintanyway (curinterp->Itaintanyway) #define tainted (curinterp->Itainted) +#define tainting (curinterp->Itainting) #define tmps_floor (curinterp->Itmps_floor) #define tmps_ix (curinterp->Itmps_ix) #define tmps_max (curinterp->Itmps_max) @@ -233,7 +1003,7 @@ #define toptarget (curinterp->Itoptarget) #define unsafe (curinterp->Iunsafe) -#else /* not embedded, so translate interpreter variables the other way... */ +#else /* not multiple, so translate interpreter variables the other way... */ #define IArgv Argv #define ICmd Cmd @@ -265,7 +1035,6 @@ #define Icxstack_ix cxstack_ix #define Icxstack_max cxstack_max #define Idbargs dbargs -#define Idbmrefcnt dbmrefcnt #define Idebdelim debdelim #define Idebname debname #define Idebstash debstash @@ -371,8 +1140,8 @@ #define Istatusvalue statusvalue #define Istdingv stdingv #define Istrchop strchop -#define Itaintanyway taintanyway #define Itainted tainted +#define Itainting tainting #define Itmps_floor tmps_floor #define Itmps_ix tmps_ix #define Itmps_max tmps_max @@ -381,4 +1150,4 @@ #define Itoptarget toptarget #define Iunsafe unsafe -#endif +#endif /* MULTIPLE_INTERPRETERS */ diff --git a/embed_h.SH b/embed_h.SH index 78838aabf7..d78bffbd9d 100755 --- a/embed_h.SH +++ b/embed_h.SH @@ -5,7 +5,7 @@ cat <<'END' >embed.h /* (Doing namespace management portably in C is really gross.) */ -#ifdef EMBEDDED +#ifdef EMBED /* globals we need to hide from the world */ END @@ -18,7 +18,11 @@ sed <global.var >>embed.h \ cat <<'END' >> embed.h -/* interpreter specific variables */ +#endif /* EMBEDDED */ + +/* Put interpreter specific variables into a struct? */ + +#ifdef MULTIPLICITY END @@ -31,7 +35,7 @@ sed <interp.var >>embed.h \ cat <<'END' >> embed.h -#else /* not embedded, so translate interpreter variables the other way... */ +#else /* not multiple, so translate interpreter variables the other way... */ END @@ -43,6 +47,6 @@ sed <interp.var >>embed.h \ cat <<'END' >> embed.h -#endif +#endif /* MULTIPLE_INTERPRETERS */ END diff --git a/usub/README b/ext/README index a80a650d7b..a80a650d7b 100644 --- a/usub/README +++ b/ext/README diff --git a/usub/Makefile b/ext/curses/Makefile index 107702f303..107702f303 100644 --- a/usub/Makefile +++ b/ext/curses/Makefile diff --git a/usub/bsdcurses.mus b/ext/curses/bsdcurses.mus index 7129418ab6..7129418ab6 100644 --- a/usub/bsdcurses.mus +++ b/ext/curses/bsdcurses.mus diff --git a/usub/curses.mus b/ext/curses/curses.mus index 35510f4da7..35510f4da7 100644 --- a/usub/curses.mus +++ b/ext/curses/curses.mus diff --git a/usub/pager b/ext/curses/pager index 407bc50670..407bc50670 100644 --- a/usub/pager +++ b/ext/curses/pager diff --git a/ext/dbm/GDBM_File.c b/ext/dbm/GDBM_File.c new file mode 100644 index 0000000000..b5d4a8884a --- /dev/null +++ b/ext/dbm/GDBM_File.c @@ -0,0 +1,310 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <gdbm.h> + +#include <fcntl.h> + +typedef GDBM_FILE GDBM_File; + +#define gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func) \ + gdbm_open(name, block_size, read_write, mode, fatal_func) + +typedef datum gdatum; + +typedef void (*FATALFUNC)(); + +static int +XS_GDBM_File_gdbm_new(ix, sp, items) +register int ix; +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)"); + } + { + char * dbtype = SvPV(ST(1),na); + char * name = SvPV(ST(2),na); + int block_size = (int)SvIV(ST(3)); + int read_write = (int)SvIV(ST(4)); + int mode = (int)SvIV(ST(5)); + FATALFUNC fatal_func; + GDBM_File RETVAL; + + if (items < 6) + fatal_func = (FATALFUNC)fatal; + else { + fatal_func = (FATALFUNC)SvPV(ST(6),na); + } + + RETVAL = gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setptrobj(ST(0), RETVAL, "GDBM_File"); + } + return sp; +} + +static int +XS_GDBM_File_gdbm_open(ix, sp, items) +register int ix; +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)"); + } + { + char * name = SvPV(ST(1),na); + int block_size = (int)SvIV(ST(2)); + int read_write = (int)SvIV(ST(3)); + int mode = (int)SvIV(ST(4)); + FATALFUNC fatal_func; + GDBM_File RETVAL; + + if (items < 5) + fatal_func = (FATALFUNC)fatal; + else { + fatal_func = (FATALFUNC)SvPV(ST(5),na); + } + + RETVAL = gdbm_open(name, block_size, read_write, mode, fatal_func); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setptrobj(ST(0), RETVAL, "GDBM_File"); + } + return sp; +} + +static int +XS_GDBM_File_gdbm_close(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("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))); + else + fatal("db is not of type GDBM_File"); + + gdbm_close(db); + } + return sp; +} + +static int +XS_GDBM_File_gdbm_DESTROY(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("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))); + else + fatal("db is not of type GDBM_File"); + gdbm_close(db); + } + return sp; +} + +static int +XS_GDBM_File_gdbm_fetch(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + fatal("Usage: GDBM_File::fetch(db, key)"); + } + { + GDBM_File db; + datum key; + gdatum RETVAL; + + if (sv_isa(ST(1), "GDBM_File")) + db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type GDBM_File"); + + key.dptr = SvPV(ST(2), key.dsize);; + + RETVAL = gdbm_fetch(db, key); + ST(0) = sv_mortalcopy(&sv_undef); + sv_usepvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_GDBM_File_gdbm_store(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 3 || items > 4) { + fatal("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)"); + } + { + GDBM_File db; + datum key; + datum value; + int flags; + int RETVAL; + + if (sv_isa(ST(1), "GDBM_File")) + db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type GDBM_File"); + + key.dptr = SvPV(ST(2), key.dsize);; + + value.dptr = SvPV(ST(3), value.dsize);; + + if (items < 4) + flags = GDBM_REPLACE; + else { + flags = (int)SvIV(ST(4)); + } + + RETVAL = gdbm_store(db, key, value, flags); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_GDBM_File_gdbm_delete(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + fatal("Usage: GDBM_File::delete(db, key)"); + } + { + GDBM_File db; + datum key; + int RETVAL; + + if (sv_isa(ST(1), "GDBM_File")) + db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type GDBM_File"); + + key.dptr = SvPV(ST(2), key.dsize);; + + RETVAL = gdbm_delete(db, key); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_GDBM_File_gdbm_firstkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("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))); + else + fatal("db is not of type GDBM_File"); + + RETVAL = gdbm_firstkey(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_usepvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_GDBM_File_gdbm_nextkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + fatal("Usage: GDBM_File::nextkey(db, key)"); + } + { + GDBM_File db; + datum key; + gdatum RETVAL; + + if (sv_isa(ST(1), "GDBM_File")) + db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type GDBM_File"); + + key.dptr = SvPV(ST(2), key.dsize);; + + RETVAL = gdbm_nextkey(db, key); + ST(0) = sv_mortalcopy(&sv_undef); + sv_usepvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_GDBM_File_gdbm_reorganize(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("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))); + else + fatal("db is not of type GDBM_File"); + + RETVAL = gdbm_reorganize(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +int init_GDBM_File(ix,sp,items) +int ix; +int sp; +int items; +{ + char* file = __FILE__; + + newXSUB("GDBM_File::new", 0, XS_GDBM_File_gdbm_new, file); + newXSUB("GDBM_File::open", 0, XS_GDBM_File_gdbm_open, file); + newXSUB("GDBM_File::close", 0, XS_GDBM_File_gdbm_close, file); + newXSUB("GDBM_File::DESTROY", 0, XS_GDBM_File_gdbm_DESTROY, file); + newXSUB("GDBM_File::fetch", 0, XS_GDBM_File_gdbm_fetch, file); + newXSUB("GDBM_File::store", 0, XS_GDBM_File_gdbm_store, file); + newXSUB("GDBM_File::delete", 0, XS_GDBM_File_gdbm_delete, file); + newXSUB("GDBM_File::firstkey", 0, XS_GDBM_File_gdbm_firstkey, file); + newXSUB("GDBM_File::nextkey", 0, XS_GDBM_File_gdbm_nextkey, file); + newXSUB("GDBM_File::reorganize", 0, XS_GDBM_File_gdbm_reorganize, file); +} diff --git a/ext/dbm/GDBM_File.xs b/ext/dbm/GDBM_File.xs new file mode 100644 index 0000000000..2c619cbe42 --- /dev/null +++ b/ext/dbm/GDBM_File.xs @@ -0,0 +1,76 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <gdbm.h> + +#include <fcntl.h> + +typedef GDBM_FILE GDBM_File; + +#define gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func) \ + gdbm_open(name, block_size, read_write, mode, fatal_func) + +typedef datum gdatum; + +typedef void (*FATALFUNC)(); + +MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ + +GDBM_File +gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak) + char * dbtype + char * name + int block_size + int read_write + int mode + FATALFUNC fatal_func + +GDBM_File +gdbm_open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak) + char * name + int block_size + int read_write + int mode + FATALFUNC fatal_func + +void +gdbm_close(db) + GDBM_File db + CLEANUP: + +void +gdbm_DESTROY(db) + GDBM_File db + CODE: + gdbm_close(db); + +gdatum +gdbm_fetch(db, key) + GDBM_File db + datum key + +int +gdbm_store(db, key, value, flags = GDBM_REPLACE) + GDBM_File db + datum key + datum value + int flags + +int +gdbm_delete(db, key) + GDBM_File db + datum key + +gdatum +gdbm_firstkey(db) + GDBM_File db + +gdatum +gdbm_nextkey(db, key) + GDBM_File db + datum key + +int +gdbm_reorganize(db) + GDBM_File db + diff --git a/ext/dbm/GDBM_File.xs.bak b/ext/dbm/GDBM_File.xs.bak new file mode 100644 index 0000000000..03b86c5739 --- /dev/null +++ b/ext/dbm/GDBM_File.xs.bak @@ -0,0 +1,122 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <gdbm.h> + +#include <fcntl.h> + +typedef GDBM_FILE GDBM_File; + +#define gdbm_new(dbtype,filename,flags,mode) \ + gdbm_open(filename, 0, flags & O_CREAT ? GDBM_WRCREAT : GDBM_WRITER, \ + mode, fatal) + +typedef datum gdatum; + +typedef struct gdbm_file_desc { + GDBM_File ptr; + SV* curkey; +} GDBM_FILE_DESC; + +GDBM_FILE_DESC* GDBM_File_desc; + +GDBM_FILE_DESC* +newGDBM_FILE_DESC(ptr) +void* ptr; +{ + New(0, GDBM_File_desc, 1, GDBM_FILE_DESC); + GDBM_File_desc->ptr = ptr; + GDBM_File_desc->curkey = 0; + return GDBM_File_desc; +} + +void +deleteGDBM_FILE_DESC() +{ + sv_free(GDBM_File_desc->curkey); + Safefree(GDBM_File_desc); +} + +typedef void (*FATALFUNC)(); + +static datum +get_current_key() +{ + datum key; + key.dptr = SvPVn( GDBM_File_desc->curkey, key.dsize); + return key; +} + +static void +set_current_key(sv) +SV *sv; +{ + sv_free(GDBM_File_desc->curkey); + GDBM_File_desc->curkey = sv_ref(sv); +} + + +MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ + +GDBM_File +gdbm_new(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + +GDBM_File +gdbm_open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal) + char * name + int block_size + int read_write + int mode + FATALFUNC fatal_func + +void +gdbm_close(db) + GDBM_File db + CLEANUP: + deleteGDBM_FILE_DESC(); + +void +gdbm_DESTROY(db) + GDBM_File db + CODE: + gdbm_close(db); + deleteGDBM_FILE_DESC(); + +gdatum +gdbm_fetch(db, key) + GDBM_File db + datum key + +int +gdbm_store(db, key, value, flags = GDBM_REPLACE) + GDBM_File db + datum key + datum value + int flags + +int +gdbm_delete(db, key) + GDBM_File db + datum key + +gdatum +gdbm_firstkey(db) + GDBM_File db + CLEANUP: + set_current_key(ST(0)); + +gdatum +gdbm_nextkey(db, key = get_current_key()) + GDBM_File db + datum key + CLEANUP: + set_current_key(ST(0)); + +int +gdbm_reorganize(db) + GDBM_File db + diff --git a/ext/dbm/Makefile b/ext/dbm/Makefile new file mode 100644 index 0000000000..61afe01e64 --- /dev/null +++ b/ext/dbm/Makefile @@ -0,0 +1,14 @@ +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 + +SDBM_File.c: SDBM_File.xs + ../xsubpp ../typemap SDBM_File.xs >SDBM_File.c + +ODBM_File.c: ODBM_File.xs + ../xsubpp ../typemap ODBM_File.xs >ODBM_File.c + +GDBM_File.c: GDBM_File.xs + ../xsubpp ../typemap GDBM_File.xs >GDBM_File.c + diff --git a/ext/dbm/NDBM_File.c b/ext/dbm/NDBM_File.c new file mode 100644 index 0000000000..b321ac4252 --- /dev/null +++ b/ext/dbm/NDBM_File.c @@ -0,0 +1,267 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <ndbm.h> + +typedef DBM* NDBM_File; +#define dbm_new(dbtype,filename,flags,mode) dbm_open(filename,flags,mode) +#define nextkey(db,key) dbm_nextkey(db) + +static int +XS_NDBM_File_dbm_new(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 4 || items > 4) { + fatal("Usage: NDBM_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)); + NDBM_File RETVAL; + + RETVAL = dbm_new(dbtype, filename, flags, mode); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setptrobj(ST(0), RETVAL, "NDBM_File"); + } + return sp; +} + +static int +XS_NDBM_File_dbm_DESTROY(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("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))); + else + fatal("db is not of type NDBM_File"); + dbm_close(db); + } + return sp; +} + +static int +XS_NDBM_File_dbm_fetch(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + fatal("Usage: NDBM_File::fetch(db, key)"); + } + { + NDBM_File db; + datum key; + datum RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("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); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_NDBM_File_dbm_store(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 3 || items > 4) { + fatal("Usage: NDBM_File::store(db, key, value, flags = DBM_REPLACE)"); + } + { + NDBM_File db; + datum key; + datum value; + int flags; + int RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type NDBM_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 = dbm_store(db, key, value, flags); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_NDBM_File_dbm_delete(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + fatal("Usage: NDBM_File::delete(db, key)"); + } + { + NDBM_File db; + datum key; + int RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("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); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_NDBM_File_dbm_firstkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("Usage: NDBM_File::firstkey(db)"); + } + { + NDBM_File db; + datum RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type NDBM_File"); + + RETVAL = dbm_firstkey(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_NDBM_File_nextkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + fatal("Usage: NDBM_File::nextkey(db, key)"); + } + { + NDBM_File db; + datum key; + datum RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type NDBM_File"); + + key.dptr = SvPV(ST(2), key.dsize);; + + RETVAL = nextkey(db, key); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_NDBM_File_dbm_error(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("Usage: NDBM_File::error(db)"); + } + { + NDBM_File db; + int RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type NDBM_File"); + + RETVAL = dbm_error(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_NDBM_File_dbm_clearerr(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("Usage: NDBM_File::clearerr(db)"); + } + { + NDBM_File db; + int RETVAL; + + if (sv_isa(ST(1), "NDBM_File")) + db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type NDBM_File"); + + RETVAL = dbm_clearerr(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +int init_NDBM_File(ix,sp,items) +int ix; +int sp; +int items; +{ + char* file = __FILE__; + + newXSUB("NDBM_File::new", 0, XS_NDBM_File_dbm_new, file); + newXSUB("NDBM_File::DESTROY", 0, XS_NDBM_File_dbm_DESTROY, file); + newXSUB("NDBM_File::fetch", 0, XS_NDBM_File_dbm_fetch, file); + newXSUB("NDBM_File::store", 0, XS_NDBM_File_dbm_store, file); + newXSUB("NDBM_File::delete", 0, XS_NDBM_File_dbm_delete, file); + newXSUB("NDBM_File::firstkey", 0, XS_NDBM_File_dbm_firstkey, file); + newXSUB("NDBM_File::nextkey", 0, XS_NDBM_File_nextkey, file); + newXSUB("NDBM_File::error", 0, XS_NDBM_File_dbm_error, file); + newXSUB("NDBM_File::clearerr", 0, XS_NDBM_File_dbm_clearerr, file); +} diff --git a/ext/dbm/NDBM_File.xs b/ext/dbm/NDBM_File.xs new file mode 100644 index 0000000000..5f4f78b974 --- /dev/null +++ b/ext/dbm/NDBM_File.xs @@ -0,0 +1,58 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include <ndbm.h> + +typedef DBM* NDBM_File; +#define dbm_new(dbtype,filename,flags,mode) dbm_open(filename,flags,mode) +#define nextkey(db,key) dbm_nextkey(db) + +MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = dbm_ + +NDBM_File +dbm_new(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + +void +dbm_DESTROY(db) + NDBM_File db + CODE: + dbm_close(db); + +datum +dbm_fetch(db, key) + NDBM_File db + datum key + +int +dbm_store(db, key, value, flags = DBM_REPLACE) + NDBM_File db + datum key + datum value + int flags + +int +dbm_delete(db, key) + NDBM_File db + datum key + +datum +dbm_firstkey(db) + NDBM_File db + +datum +nextkey(db, key) + NDBM_File db + datum key + +int +dbm_error(db) + NDBM_File db + +int +dbm_clearerr(db) + NDBM_File db + diff --git a/ext/dbm/ODBM_File.c b/ext/dbm/ODBM_File.c new file mode 100644 index 0000000000..b2fa7ddcba --- /dev/null +++ b/ext/dbm/ODBM_File.c @@ -0,0 +1,246 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifdef NULL +#undef NULL +#endif +#include <dbm.h> + +#include <fcntl.h> + +typedef void* ODBM_File; + +#define odbm_fetch(db,key) fetch(key) +#define odbm_store(db,key,value,flags) store(key,value) +#define odbm_delete(db,key) delete(key) +#define odbm_firstkey(db) firstkey() +#define odbm_nextkey(db,key) nextkey(key) + +static int dbmrefcnt; + +#define DBM_REPLACE 0 + +static int +XS_ODBM_File_odbm_new(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 4 || items > 4) { + fatal("Usage: ODBM_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)); + ODBM_File RETVAL; + { + char tmpbuf[1025]; + if (dbmrefcnt++) + fatal("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); + sprintf(tmpbuf,"%s.pag",filename); + if (close(creat(tmpbuf,mode)) < 0) + fatal("ODBM_File: Can't create %s", filename); + } + else + fatal("ODBM_FILE: Can't open %s", filename); + } + RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setptrobj(ST(0), RETVAL, "ODBM_File"); + } + } + return sp; +} + +static int +XS_ODBM_File_DESTROY(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("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))); + else + fatal("db is not of type ODBM_File"); + dbmrefcnt--; + dbmclose(); + } + return sp; +} + +static int +XS_ODBM_File_odbm_fetch(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + fatal("Usage: ODBM_File::fetch(db, key)"); + } + { + ODBM_File db; + datum key; + datum RETVAL; + + if (sv_isa(ST(1), "ODBM_File")) + db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("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); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_ODBM_File_odbm_store(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 3 || items > 4) { + fatal("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)"); + } + { + ODBM_File db; + datum key; + datum value; + int flags; + int RETVAL; + + if (sv_isa(ST(1), "ODBM_File")) + db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("db is not of type ODBM_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 = odbm_store(db, key, value, flags); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_ODBM_File_odbm_delete(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + fatal("Usage: ODBM_File::delete(db, key)"); + } + { + ODBM_File db; + datum key; + int RETVAL; + + if (sv_isa(ST(1), "ODBM_File")) + db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("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); + sv_setiv(ST(0), (I32)RETVAL); + } + return sp; +} + +static int +XS_ODBM_File_odbm_firstkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 1 || items > 1) { + fatal("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))); + else + fatal("db is not of type ODBM_File"); + + RETVAL = odbm_firstkey(db); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +static int +XS_ODBM_File_odbm_nextkey(ix, sp, items) +register int ix; +register int sp; +register int items; +{ + if (items < 2 || items > 2) { + fatal("Usage: ODBM_File::nextkey(db, key)"); + } + { + ODBM_File db; + datum key; + datum RETVAL; + + if (sv_isa(ST(1), "ODBM_File")) + db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); + else + fatal("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); + sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); + } + return sp; +} + +int init_ODBM_File(ix,sp,items) +int ix; +int sp; +int items; +{ + char* file = __FILE__; + + newXSUB("ODBM_File::new", 0, XS_ODBM_File_odbm_new, file); + newXSUB("ODBM_File::DESTROY", 0, XS_ODBM_File_DESTROY, file); + newXSUB("ODBM_File::fetch", 0, XS_ODBM_File_odbm_fetch, file); + newXSUB("ODBM_File::store", 0, XS_ODBM_File_odbm_store, file); + newXSUB("ODBM_File::delete", 0, XS_ODBM_File_odbm_delete, file); + newXSUB("ODBM_File::firstkey", 0, XS_ODBM_File_odbm_firstkey, file); + newXSUB("ODBM_File::nextkey", 0, XS_ODBM_File_odbm_nextkey, file); +} diff --git a/ext/dbm/ODBM_File.xs b/ext/dbm/ODBM_File.xs new file mode 100644 index 0000000000..74554c71e6 --- /dev/null +++ b/ext/dbm/ODBM_File.xs @@ -0,0 +1,86 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifdef NULL +#undef NULL +#endif +#include <dbm.h> + +#include <fcntl.h> + +typedef void* ODBM_File; + +#define odbm_fetch(db,key) fetch(key) +#define odbm_store(db,key,value,flags) store(key,value) +#define odbm_delete(db,key) delete(key) +#define odbm_firstkey(db) firstkey() +#define odbm_nextkey(db,key) nextkey(key) + +static int dbmrefcnt; + +#define DBM_REPLACE 0 + +MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ + +ODBM_File +odbm_new(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + CODE: + { + char tmpbuf[1025]; + if (dbmrefcnt++) + 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) + croak("ODBM_File: Can't create %s", filename); + sprintf(tmpbuf,"%s.pag",filename); + if (close(creat(tmpbuf,mode)) < 0) + croak("ODBM_File: Can't create %s", filename); + } + else + croak("ODBM_FILE: Can't open %s", filename); + } + RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setptrobj(ST(0), RETVAL, "ODBM_File"); + } + +void +DESTROY(db) + ODBM_File db + CODE: + dbmrefcnt--; + dbmclose(); + +datum +odbm_fetch(db, key) + ODBM_File db + datum key + +int +odbm_store(db, key, value, flags = DBM_REPLACE) + ODBM_File db + datum key + datum value + int flags + +int +odbm_delete(db, key) + ODBM_File db + datum key + +datum +odbm_firstkey(db) + ODBM_File db + +datum +odbm_nextkey(db, key) + ODBM_File db + datum key + diff --git a/ext/dbm/SDBM_File.c b/ext/dbm/SDBM_File.c new file mode 100644 index 0000000000..7baafc4a98 --- /dev/null +++ b/ext/dbm/SDBM_File.c @@ -0,0 +1,266 @@ +#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_File.xs b/ext/dbm/SDBM_File.xs new file mode 100644 index 0000000000..0b898ad171 --- /dev/null +++ b/ext/dbm/SDBM_File.xs @@ -0,0 +1,57 @@ +#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) + +MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_ + +SDBM_File +sdbm_new(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + +void +sdbm_DESTROY(db) + SDBM_File db + CODE: + sdbm_close(db); + +datum +sdbm_fetch(db, key) + SDBM_File db + datum key + +int +sdbm_store(db, key, value, flags = DBM_REPLACE) + SDBM_File db + datum key + datum value + int flags + +int +sdbm_delete(db, key) + SDBM_File db + datum key + +datum +sdbm_firstkey(db) + SDBM_File db + +datum +sdbm_nextkey(db, key) + SDBM_File db + datum key + +int +sdbm_error(db) + SDBM_File db + +int +sdbm_clearerr(db) + SDBM_File db + diff --git a/ext/dbm/sdbm/.pure b/ext/dbm/sdbm/.pure new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/ext/dbm/sdbm/.pure diff --git a/ext/dbm/sdbm/.r b/ext/dbm/sdbm/.r new file mode 100755 index 0000000000..c72dbf15f5 --- /dev/null +++ b/ext/dbm/sdbm/.r @@ -0,0 +1,5884 @@ +if test -f 'CHANGES' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'CHANGES'\" +else +echo shar: Extracting \"'CHANGES'\" \(900 characters\) +sed "s/^X//" >'CHANGES' <<'END_OF_FILE' +XChanges from the earlier BETA releases. +X +Xo dbm_prep does everything now, so dbm_open is just a simple +X wrapper that builds the default filenames. dbm_prep no longer +X requires a (DBM *) db parameter: it allocates one itself. It +X returns (DBM *) db or (DBM *) NULL. +X +Xo makroom is now reliable. In the common-case optimization of the page +X split, the page into which the incoming key/value pair is to be inserted +X is write-deferred (if the split is successful), thereby saving a cosly +X write. BUT, if the split does not make enough room (unsuccessful), the +X deferred page is written out, as the failure-window is now dependent on +X the number of split attempts. +X +Xo if -DDUFF is defined, hash function will also use the DUFF construct. +X This may look like a micro-performance tweak (maybe it is), but in fact, +X the hash function is the third most-heavily used function, after read +X and write. +END_OF_FILE +if test 900 -ne `wc -c <'CHANGES'`; then + echo shar: \"'CHANGES'\" unpacked with wrong size! +fi +# end of 'CHANGES' +fi +if test -f 'COMPARE' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'COMPARE'\" +else +echo shar: Extracting \"'COMPARE'\" \(2832 characters\) +sed "s/^X//" >'COMPARE' <<'END_OF_FILE' +X +XScript started on Thu Sep 28 15:41:06 1989 +X% uname -a +Xtitan titan 4_0 UMIPS mips +X% make all x-dbm +X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbm.c +X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c sdbm.c +X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c pair.c +X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c hash.c +X ar cr libsdbm.a sdbm.o pair.o hash.o +X ranlib libsdbm.a +X cc -o dbm dbm.o libsdbm.a +X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dba.c +X cc -o dba dba.o +X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbd.c +X cc -o dbd dbd.o +X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -o x-dbm dbm.o +X% +X% +X% wc history +X 65110 218344 3204883 history +X% +X% /bin/time dbm build foo <history +X +Xreal 5:56.9 +Xuser 13.3 +Xsys 26.3 +X% ls -s +Xtotal 14251 +X 5 README 2 dbd.c 1 hash.c 1 pair.h +X 0 SCRIPT 5 dbd.o 1 hash.o 5 pair.o +X 1 WISHLIST 62 dbm 3130 history 1 port.h +X 46 dba 5 dbm.c 11 howtodbm.txt 11 sdbm.c +X 3 dba.c 8 dbm.o 14 libsdbm.a 2 sdbm.h +X 6 dba.o 4 foo.dir 1 makefile 8 sdbm.o +X 46 dbd 10810 foo.pag 6 pair.c 60 x-dbm +X% ls -l foo.* +X-rw-r--r-- 1 oz 4096 Sep 28 15:48 foo.dir +X-rw-r--r-- 1 oz 11069440 Sep 28 15:48 foo.pag +X% +X% /bin/time x-dbm build bar <history +X +Xreal 5:59.4 +Xuser 24.7 +Xsys 29.1 +X% +X% ls -s +Xtotal 27612 +X 5 README 46 dbd 1 hash.c 5 pair.o +X 1 SCRIPT 2 dbd.c 1 hash.o 1 port.h +X 1 WISHLIST 5 dbd.o 3130 history 11 sdbm.c +X 4 bar.dir 62 dbm 11 howtodbm.txt 2 sdbm.h +X13356 bar.pag 5 dbm.c 14 libsdbm.a 8 sdbm.o +X 46 dba 8 dbm.o 1 makefile 60 x-dbm +X 3 dba.c 4 foo.dir 6 pair.c +X 6 dba.o 10810 foo.pag 1 pair.h +X% +X% ls -l bar.* +X-rw-r--r-- 1 oz 4096 Sep 28 15:54 bar.dir +X-rw-r--r-- 1 oz 13676544 Sep 28 15:54 bar.pag +X% +X% dba foo | tail +X#10801: ok. no entries. +X#10802: ok. no entries. +X#10803: ok. no entries. +X#10804: ok. no entries. +X#10805: ok. no entries. +X#10806: ok. no entries. +X#10807: ok. no entries. +X#10808: ok. no entries. +X#10809: ok. 11 entries 67% used free 337. +X10810 pages (6036 holes): 65073 entries +X% +X% dba bar | tail +X#13347: ok. no entries. +X#13348: ok. no entries. +X#13349: ok. no entries. +X#13350: ok. no entries. +X#13351: ok. no entries. +X#13352: ok. no entries. +X#13353: ok. no entries. +X#13354: ok. no entries. +X#13355: ok. 7 entries 33% used free 676. +X13356 pages (8643 holes): 65073 entries +X% +X% exit +Xscript done on Thu Sep 28 16:08:45 1989 +X +END_OF_FILE +if test 2832 -ne `wc -c <'COMPARE'`; then + echo shar: \"'COMPARE'\" unpacked with wrong size! +fi +# end of 'COMPARE' +fi +if test -f 'README' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'README'\" +else +echo shar: Extracting \"'README'\" \(11457 characters\) +sed "s/^X//" >'README' <<'END_OF_FILE' +X +X +X +X +X +X +X sdbm - Substitute DBM +X or +X Berkeley ndbm for Every UN*X[1] Made Simple +X +X Ozan (oz) Yigit +X +X The Guild of PD Software Toolmakers +X Toronto - Canada +X +X oz@nexus.yorku.ca +X +X +X +XImplementation is the sincerest form of flattery. - L. Peter +XDeutsch +X +XA The Clone of the ndbm library +X +X The sources accompanying this notice - sdbm - consti- +Xtute the first public release (Dec. 1990) of a complete +Xclone of the Berkeley UN*X ndbm library. The sdbm library is +Xmeant to clone the proven functionality of ndbm as closely +Xas possible, including a few improvements. It is practical, +Xeasy to understand, and compatible. The sdbm library is not +Xderived from any licensed, proprietary or copyrighted +Xsoftware. +X +X The sdbm implementation is based on a 1978 algorithm +X[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''. +XIn the course of searching for a substitute for ndbm, I pro- +Xtotyped three different external-hashing algorithms [Lar78, +XFag79, Lit80] and ultimately chose Larson's algorithm as a +Xbasis of the sdbm implementation. The Bell Labs dbm (and +Xtherefore ndbm) is based on an algorithm invented by Ken +XThompson, [Tho90, Tor87] and predates Larson's work. +X +X The sdbm programming interface is totally compatible +Xwith ndbm and includes a slight improvement in database ini- +Xtialization. It is also expected to be binary-compatible +Xunder most UN*X versions that support the ndbm library. +X +X The sdbm implementation shares the shortcomings of the +Xndbm library, as a side effect of various simplifications to +Xthe original Larson algorithm. It does produce holes in the +Xpage file as it writes pages past the end of file. (Larson's +Xpaper include a clever solution to this problem that is a +Xresult of using the hash value directly as a block address.) +XOn the other hand, extensive tests seem to indicate that +Xsdbm creates fewer holes in general, and the resulting page- +Xfiles are smaller. The sdbm implementation is also faster +Xthan ndbm in database creation. Unlike the ndbm, the sdbm +X_________________________ +X +X [1] UN*X is not a trademark of any (dis)organization. +X +X +X +X +X +X +X +X +X +X - 2 - +X +X +Xstore operation will not ``wander away'' trying to split its +Xdata pages to insert a datum that cannot (due to elaborate +Xworst-case situations) be inserted. (It will fail after a +Xpre-defined number of attempts.) +X +XImportant Compatibility Warning +X +X The sdbm and ndbm libraries cannot share databases: one +Xcannot read the (dir/pag) database created by the other. +XThis is due to the differences between the ndbm and sdbm +Xalgorithms[2], and the hash functions used. It is easy to +Xconvert between the dbm/ndbm databases and sdbm by ignoring +Xthe index completely: see dbd, dbu etc. +X +X +XNotice of Intellectual Property +X +XThe entire sdbm library package, as authored by me, Ozan S. +XYigit, is hereby placed in the public domain. As such, the +Xauthor is not responsible for the consequences of use of +Xthis software, no matter how awful, even if they arise from +Xdefects in it. There is no expressed or implied warranty for +Xthe sdbm library. +X +X Since the sdbm library package is in the public domain, +Xthis original release or any additional public-domain +Xreleases of the modified original cannot possibly (by defin- +Xition) be withheld from you. Also by definition, You (singu- +Xlar) have all the rights to this code (including the right +Xto sell without permission, the right to hoard[3] and the +Xright to do other icky things as you see fit) but those +Xrights are also granted to everyone else. +X +X Please note that all previous distributions of this +Xsoftware contained a copyright (which is now dropped) to +Xprotect its origins and its current public domain status +Xagainst any possible claims and/or challenges. +X +XAcknowledgments +X +X Many people have been very helpful and supportive. A +Xpartial list would necessarily include Rayan Zacherissen +X(who contributed the man page, and also hacked a MMAP +X_________________________ +X +X [2] Torek's discussion [Tor87] indicates that +Xdbm/ndbm implementations use the hash value to traverse +Xthe radix trie differently than sdbm and as a result, +Xthe page indexes are generated in different order. For +Xmore information, send e-mail to the author. +X [3] You cannot really hoard something that is avail- +Xable to the public at large, but try if it makes you +Xfeel any better. +X +X +X +X +X +X +X +X +X +X +X - 3 - +X +X +Xversion of sdbm), Arnold Robbins, Chris Lewis, Bill David- +Xsen, Henry Spencer, Geoff Collyer, Rich Salz (who got me +Xstarted in the first place), Johannes Ruschein (who did the +Xminix port) and David Tilbrook. I thank you all. +X +XDistribution Manifest and Notes +X +XThis distribution of sdbm includes (at least) the following: +X +X CHANGES change log +X README this file. +X biblio a small bibliography on external hashing +X dba.c a crude (n/s)dbm page file analyzer +X dbd.c a crude (n/s)dbm page file dumper (for conversion) +X dbe.1 man page for dbe.c +X dbe.c Janick's database editor +X dbm.c a dbm library emulation wrapper for ndbm/sdbm +X dbm.h header file for the above +X dbu.c a crude db management utility +X hash.c hashing function +X makefile guess. +X pair.c page-level routines (posted earlier) +X pair.h header file for the above +X readme.ms troff source for the README file +X sdbm.3 man page +X sdbm.c the real thing +X sdbm.h header file for the above +X tune.h place for tuning & portability thingies +X util.c miscellaneous +X +X dbu is a simple database manipulation program[4] that +Xtries to look like Bell Labs' cbt utility. It is currently +Xincomplete in functionality. I use dbu to test out the rou- +Xtines: it takes (from stdin) tab separated key/value pairs +Xfor commands like build or insert or takes keys for commands +Xlike delete or look. +X +X dbu <build|creat|look|insert|cat|delete> dbmfile +X +X dba is a crude analyzer of dbm/sdbm/ndbm page files. It +Xscans the entire page file, reporting page level statistics, +Xand totals at the end. +X +X dbd is a crude dump program for dbm/ndbm/sdbm data- +Xbases. It ignores the bitmap, and dumps the data pages in +Xsequence. It can be used to create input for the dbu util- +Xity. Note that dbd will skip any NULLs in the key and data +Xfields, thus is unsuitable to convert some peculiar +X_________________________ +X +X [4] The dbd, dba, dbu utilities are quick hacks and +Xare not fit for production use. They were developed +Xlate one night, just to test out sdbm, and convert some +Xdatabases. +X +X +X +X +X +X +X +X +X +X - 4 - +X +X +Xdatabases that insist in including the terminating null. +X +X I have also included a copy of the dbe (ndbm DataBase +XEditor) by Janick Bergeron [janick@bnr.ca] for your pleas- +Xure. You may find it more useful than the little dbu util- +Xity. +X +X dbm.[ch] is a dbm library emulation on top of ndbm (and +Xhence suitable for sdbm). Written by Robert Elz. +X +X The sdbm library has been around in beta test for quite +Xa long time, and from whatever little feedback I received +X(maybe no news is good news), I believe it has been func- +Xtioning without any significant problems. I would, of +Xcourse, appreciate all fixes and/or improvements. Portabil- +Xity enhancements would especially be useful. +X +XImplementation Issues +X +X Hash functions: The algorithm behind sdbm implementa- +Xtion needs a good bit-scrambling hash function to be effec- +Xtive. I ran into a set of constants for a simple hash func- +Xtion that seem to help sdbm perform better than ndbm for +Xvarious inputs: +X +X /* +X * polynomial conversion ignoring overflows +X * 65599 nice. 65587 even better. +X */ +X long +X dbm_hash(char *str, int len) { +X register unsigned long n = 0; +X +X while (len--) +X n = n * 65599 + *str++; +X return n; +X } +X +X There may be better hash functions for the purposes of +Xdynamic hashing. Try your favorite, and check the pagefile. +XIf it contains too many pages with too many holes, (in rela- +Xtion to this one for example) or if sdbm simply stops work- +Xing (fails after SPLTMAX attempts to split) when you feed +Xyour NEWS history file to it, you probably do not have a +Xgood hashing function. If you do better (for different +Xtypes of input), I would like to know about the function you +Xuse. +X +X Block sizes: It seems (from various tests on a few +Xmachines) that a page file block size PBLKSIZ of 1024 is by +Xfar the best for performance, but this also happens to limit +Xthe size of a key/value pair. Depending on your needs, you +Xmay wish to increase the page size, and also adjust PAIRMAX +X(the maximum size of a key/value pair allowed: should always +X +X +X +X +X +X +X +X +X +X - 5 - +X +X +Xbe at least three words smaller than PBLKSIZ.) accordingly. +XThe system-wide version of the library should probably be +Xconfigured with 1024 (distribution default), as this appears +Xto be sufficient for most common uses of sdbm. +X +XPortability +X +X This package has been tested in many different UN*Xes +Xeven including minix, and appears to be reasonably portable. +XThis does not mean it will port easily to non-UN*X systems. +X +XNotes and Miscellaneous +X +X The sdbm is not a very complicated package, at least +Xnot after you familiarize yourself with the literature on +Xexternal hashing. There are other interesting algorithms in +Xexistence that ensure (approximately) single-read access to +Xa data value associated with any key. These are directory- +Xless schemes such as linear hashing [Lit80] (+ Larson varia- +Xtions), spiral storage [Mar79] or directory schemes such as +Xextensible hashing [Fag79] by Fagin et al. I do hope these +Xsources provide a reasonable playground for experimentation +Xwith other algorithms. See the June 1988 issue of ACM Com- +Xputing Surveys [Enb88] for an excellent overview of the +Xfield. +X +XReferences +X +X +X[Lar78] +X P.-A. Larson, ``Dynamic Hashing'', BIT, vol. 18, pp. +X 184-201, 1978. +X +X[Tho90] +X Ken Thompson, private communication, Nov. 1990 +X +X[Lit80] +X W. Litwin, `` Linear Hashing: A new tool for file and +X table addressing'', Proceedings of the 6th Conference on +X Very Large Dabatases (Montreal), pp. 212-223, Very +X Large Database Foundation, Saratoga, Calif., 1980. +X +X[Fag79] +X R. Fagin, J. Nievergelt, N. Pippinger, and H. R. +X Strong, ``Extendible Hashing - A Fast Access Method for +X Dynamic Files'', ACM Trans. Database Syst., vol. 4, +X no.3, pp. 315-344, Sept. 1979. +X +X[Wal84] +X Rich Wales, ``Discussion of "dbm" data base system'', +X USENET newsgroup unix.wizards, Jan. 1984. +X +X[Tor87] +X Chris Torek, ``Re: dbm.a and ndbm.a archives'', +X +X +X +X +X +X +X +X +X +X - 6 - +X +X +X USENET newsgroup comp.unix, 1987. +X +X[Mar79] +X G. N. Martin, ``Spiral Storage: Incrementally Augment- +X able Hash Addressed Storage'', Technical Report #27, +X University of Varwick, Coventry, U.K., 1979. +X +X[Enb88] +X R. J. Enbody and H. C. Du, ``Dynamic Hashing +X Schemes'',ACM Computing Surveys, vol. 20, no. 2, pp. +X 85-113, June 1988. +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +X +END_OF_FILE +if test 11457 -ne `wc -c <'README'`; then + echo shar: \"'README'\" unpacked with wrong size! +fi +# end of 'README' +fi +if test -f 'biblio' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'biblio'\" +else +echo shar: Extracting \"'biblio'\" \(1012 characters\) +sed "s/^X//" >'biblio' <<'END_OF_FILE' +X%A R. J. Enbody +X%A H. C. Du +X%T Dynamic Hashing Schemes +X%J ACM Computing Surveys +X%V 20 +X%N 2 +X%D June 1988 +X%P 85-113 +X%K surveys +X +X%A P.-A. Larson +X%T Dynamic Hashing +X%J BIT +X%V 18 +X%P 184-201 +X%D 1978 +X%K dynamic +X +X%A W. Litwin +X%T Linear Hashing: A new tool for file and table addressing +X%J Proceedings of the 6th Conference on Very Large Dabatases (Montreal) +X%I Very Large Database Foundation +X%C Saratoga, Calif. +X%P 212-223 +X%D 1980 +X%K linear +X +X%A R. Fagin +X%A J. Nievergelt +X%A N. Pippinger +X%A H. R. Strong +X%T Extendible Hashing - A Fast Access Method for Dynamic Files +X%J ACM Trans. Database Syst. +X%V 4 +X%N 3 +X%D Sept. 1979 +X%P 315-344 +X%K extend +X +X%A G. N. Martin +X%T Spiral Storage: Incrementally Augmentable Hash Addressed Storage +X%J Technical Report #27 +X%I University of Varwick +X%C Coventry, U.K. +X%D 1979 +X%K spiral +X +X%A Chris Torek +X%T Re: dbm.a and ndbm.a archives +X%B USENET newsgroup comp.unix +X%D 1987 +X%K torek +X +X%A Rich Wales +X%T Discusson of "dbm" data base system +X%B USENET newsgroup unix.wizards +X%D Jan. 1984 +X%K rich +X +X +X +X +X +X +END_OF_FILE +if test 1012 -ne `wc -c <'biblio'`; then + echo shar: \"'biblio'\" unpacked with wrong size! +fi +# end of 'biblio' +fi +if test -f 'dba.c' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'dba.c'\" +else +echo shar: Extracting \"'dba.c'\" \(1273 characters\) +sed "s/^X//" >'dba.c' <<'END_OF_FILE' +X/* +X * dba dbm analysis/recovery +X */ +X +X#include <stdio.h> +X#include <sys/file.h> +X#include "sdbm.h" +X +Xchar *progname; +Xextern void oops(); +X +Xint +Xmain(argc, argv) +Xchar **argv; +X{ +X int n; +X char *p; +X char *name; +X int pagf; +X +X progname = argv[0]; +X +X if (p = argv[1]) { +X name = (char *) malloc((n = strlen(p)) + 5); +X strcpy(name, p); +X strcpy(name + n, ".pag"); +X +X if ((pagf = open(name, O_RDONLY)) < 0) +X oops("cannot open %s.", name); +X +X sdump(pagf); +X } +X else +X oops("usage: %s dbname", progname); +X +X return 0; +X} +X +Xsdump(pagf) +Xint pagf; +X{ +X register b; +X register n = 0; +X register t = 0; +X register o = 0; +X register e; +X char pag[PBLKSIZ]; +X +X while ((b = read(pagf, pag, PBLKSIZ)) > 0) { +X printf("#%d: ", n); +X if (!okpage(pag)) +X printf("bad\n"); +X else { +X printf("ok. "); +X if (!(e = pagestat(pag))) +X o++; +X else +X t += e; +X } +X n++; +X } +X +X if (b == 0) +X printf("%d pages (%d holes): %d entries\n", n, o, t); +X else +X oops("read failed: block %d", n); +X} +X +Xpagestat(pag) +Xchar *pag; +X{ +X register n; +X register free; +X register short *ino = (short *) pag; +X +X if (!(n = ino[0])) +X printf("no entries.\n"); +X else { +X free = ino[n] - (n + 1) * sizeof(short); +X printf("%3d entries %2d%% used free %d.\n", +X n / 2, ((PBLKSIZ - free) * 100) / PBLKSIZ, free); +X } +X return n / 2; +X} +END_OF_FILE +if test 1273 -ne `wc -c <'dba.c'`; then + echo shar: \"'dba.c'\" unpacked with wrong size! +fi +# end of 'dba.c' +fi +if test -f 'dbd.c' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'dbd.c'\" +else +echo shar: Extracting \"'dbd.c'\" \(1719 characters\) +sed "s/^X//" >'dbd.c' <<'END_OF_FILE' +X/* +X * dbd - dump a dbm data file +X */ +X +X#include <stdio.h> +X#include <sys/file.h> +X#include "sdbm.h" +X +Xchar *progname; +Xextern void oops(); +X +X +X#define empty(page) (((short *) page)[0] == 0) +X +Xint +Xmain(argc, argv) +Xchar **argv; +X{ +X int n; +X char *p; +X char *name; +X int pagf; +X +X progname = argv[0]; +X +X if (p = argv[1]) { +X name = (char *) malloc((n = strlen(p)) + 5); +X strcpy(name, p); +X strcpy(name + n, ".pag"); +X +X if ((pagf = open(name, O_RDONLY)) < 0) +X oops("cannot open %s.", name); +X +X sdump(pagf); +X } +X else +X oops("usage: %s dbname", progname); +X return 0; +X} +X +Xsdump(pagf) +Xint pagf; +X{ +X register r; +X register n = 0; +X register o = 0; +X char pag[PBLKSIZ]; +X +X while ((r = read(pagf, pag, PBLKSIZ)) > 0) { +X if (!okpage(pag)) +X fprintf(stderr, "%d: bad page.\n", n); +X else if (empty(pag)) +X o++; +X else +X dispage(pag); +X n++; +X } +X +X if (r == 0) +X fprintf(stderr, "%d pages (%d holes).\n", n, o); +X else +X oops("read failed: block %d", n); +X} +X +X +X#ifdef OLD +Xdispage(pag) +Xchar *pag; +X{ +X register i, n; +X register off; +X register short *ino = (short *) pag; +X +X off = PBLKSIZ; +X for (i = 1; i < ino[0]; i += 2) { +X printf("\t[%d]: ", ino[i]); +X for (n = ino[i]; n < off; n++) +X putchar(pag[n]); +X putchar(' '); +X off = ino[i]; +X printf("[%d]: ", ino[i + 1]); +X for (n = ino[i + 1]; n < off; n++) +X putchar(pag[n]); +X off = ino[i + 1]; +X putchar('\n'); +X } +X} +X#else +Xdispage(pag) +Xchar *pag; +X{ +X register i, n; +X register off; +X register short *ino = (short *) pag; +X +X off = PBLKSIZ; +X for (i = 1; i < ino[0]; i += 2) { +X for (n = ino[i]; n < off; n++) +X if (pag[n] != 0) +X putchar(pag[n]); +X putchar('\t'); +X off = ino[i]; +X for (n = ino[i + 1]; n < off; n++) +X if (pag[n] != 0) +X putchar(pag[n]); +X putchar('\n'); +X off = ino[i + 1]; +X } +X} +X#endif +END_OF_FILE +if test 1719 -ne `wc -c <'dbd.c'`; then + echo shar: \"'dbd.c'\" unpacked with wrong size! +fi +# end of 'dbd.c' +fi +if test -f 'dbe.1' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'dbe.1'\" +else +echo shar: Extracting \"'dbe.1'\" \(1454 characters\) +sed "s/^X//" >'dbe.1' <<'END_OF_FILE' +X.TH dbe 1 "ndbm(3) EDITOR" +X.SH NAME +Xdbe \- Edit a ndbm(3) database +X.SH USAGE +Xdbe <database> [-m r|w|rw] [-crtvx] -a|-d|-f|-F|-s [<key> [<content>]] +X.SH DESCRIPTION +X\fIdbme\fP operates on ndbm(3) databases. +XIt can be used to create them, look at them or change them. +XWhen specifying the value of a key or the content of its associated entry, +X\\nnn, \\0, \\n, \\t, \\f and \\r are interpreted as usual. +XWhen displaying key/content pairs, non-printable characters are displayed +Xusing the \\nnn notation. +X.SH OPTIONS +X.IP -a +XList all entries in the database. +X.IP -c +XCreate the database if it does not exist. +X.IP -d +XDelete the entry associated with the specified key. +X.IP -f +XFetch and display the entry associated with the specified key. +X.IP -F +XFetch and display all the entries whose key match the specified +Xregular-expression +X.IP "-m r|w|rw" +XOpen the database in read-only, write-only or read-write mode +X.IP -r +XReplace the entry associated with the specified key if it already exists. +XSee option -s. +X.IP -s +XStore an entry under a specific key. +XAn error occurs if the key already exists and the option -r was not specified. +X.IP -t +XRe-initialize the database before executing the command. +X.IP -v +XVerbose mode. +XConfirm stores and deletions. +X.IP -x +XIf option -x is used with option -c, then if the database already exists, +Xan error occurs. +XThis can be used to implement a simple exclusive access locking mechanism. +X.SH SEE ALSO +Xndbm(3) +X.SH AUTHOR +Xjanick@bnr.ca +X +END_OF_FILE +if test 1454 -ne `wc -c <'dbe.1'`; then + echo shar: \"'dbe.1'\" unpacked with wrong size! +fi +# end of 'dbe.1' +fi +if test -f 'dbe.c' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'dbe.c'\" +else +echo shar: Extracting \"'dbe.c'\" \(9799 characters\) +sed "s/^X//" >'dbe.c' <<'END_OF_FILE' +X#include <stdio.h> +X#ifndef VMS +X#include <sys/file.h> +X#include <ndbm.h> +X#else +X#include "file.h" +X#include "ndbm.h" +X#endif +X#include <ctype.h> +X +X/***************************************************************************\ +X** ** +X** Function name: getopt() ** +X** Author: Henry Spencer, UofT ** +X** Coding date: 84/04/28 ** +X** ** +X** Description: ** +X** ** +X** Parses argv[] for arguments. ** +X** Works with Whitesmith's C compiler. ** +X** ** +X** Inputs - The number of arguments ** +X** - The base address of the array of arguments ** +X** - A string listing the valid options (':' indicates an ** +X** argument to the preceding option is required, a ';' ** +X** indicates an argument to the preceding option is optional) ** +X** ** +X** Outputs - Returns the next option character, ** +X** '?' for non '-' arguments ** +X** or ':' when there is no more arguments. ** +X** ** +X** Side Effects + The argument to an option is pointed to by 'optarg' ** +X** ** +X***************************************************************************** +X** ** +X** REVISION HISTORY: ** +X** ** +X** DATE NAME DESCRIPTION ** +X** YY/MM/DD ------------------ ------------------------------------ ** +X** 88/10/20 Janick Bergeron Returns '?' on unamed arguments ** +X** returns '!' on unknown options ** +X** and 'EOF' only when exhausted. ** +X** 88/11/18 Janick Bergeron Return ':' when no more arguments ** +X** 89/08/11 Janick Bergeron Optional optarg when ';' in optstring ** +X** ** +X\***************************************************************************/ +X +Xchar *optarg; /* Global argument pointer. */ +X +X#ifdef VMS +X#define index strchr +X#endif +X +Xchar +Xgetopt(argc, argv, optstring) +Xint argc; +Xchar **argv; +Xchar *optstring; +X{ +X register int c; +X register char *place; +X extern char *index(); +X static int optind = 0; +X static char *scan = NULL; +X +X optarg = NULL; +X +X if (scan == NULL || *scan == '\0') { +X +X if (optind == 0) +X optind++; +X if (optind >= argc) +X return ':'; +X +X optarg = place = argv[optind++]; +X if (place[0] != '-' || place[1] == '\0') +X return '?'; +X if (place[1] == '-' && place[2] == '\0') +X return '?'; +X scan = place + 1; +X } +X +X c = *scan++; +X place = index(optstring, c); +X if (place == NULL || c == ':' || c == ';') { +X +X (void) fprintf(stderr, "%s: unknown option %c\n", argv[0], c); +X scan = NULL; +X return '!'; +X } +X if (*++place == ':') { +X +X if (*scan != '\0') { +X +X optarg = scan; +X scan = NULL; +X +X } +X else { +X +X if (optind >= argc) { +X +X (void) fprintf(stderr, "%s: %c requires an argument\n", +X argv[0], c); +X return '!'; +X } +X optarg = argv[optind]; +X optind++; +X } +X } +X else if (*place == ';') { +X +X if (*scan != '\0') { +X +X optarg = scan; +X scan = NULL; +X +X } +X else { +X +X if (optind >= argc || *argv[optind] == '-') +X optarg = NULL; +X else { +X optarg = argv[optind]; +X optind++; +X } +X } +X } +X return c; +X} +X +X +Xvoid +Xprint_datum(db) +Xdatum db; +X{ +X int i; +X +X putchar('"'); +X for (i = 0; i < db.dsize; i++) { +X if (isprint(db.dptr[i])) +X putchar(db.dptr[i]); +X else { +X putchar('\\'); +X putchar('0' + ((db.dptr[i] >> 6) & 0x07)); +X putchar('0' + ((db.dptr[i] >> 3) & 0x07)); +X putchar('0' + (db.dptr[i] & 0x07)); +X } +X } +X putchar('"'); +X} +X +X +Xdatum +Xread_datum(s) +Xchar *s; +X{ +X datum db; +X char *p; +X int i; +X +X db.dsize = 0; +X db.dptr = (char *) malloc(strlen(s) * sizeof(char)); +X for (p = db.dptr; *s != '\0'; p++, db.dsize++, s++) { +X if (*s == '\\') { +X if (*++s == 'n') +X *p = '\n'; +X else if (*s == 'r') +X *p = '\r'; +X else if (*s == 'f') +X *p = '\f'; +X else if (*s == 't') +X *p = '\t'; +X else if (isdigit(*s) && isdigit(*(s + 1)) && isdigit(*(s + 2))) { +X i = (*s++ - '0') << 6; +X i |= (*s++ - '0') << 3; +X i |= *s - '0'; +X *p = i; +X } +X else if (*s == '0') +X *p = '\0'; +X else +X *p = *s; +X } +X else +X *p = *s; +X } +X +X return db; +X} +X +X +Xchar * +Xkey2s(db) +Xdatum db; +X{ +X char *buf; +X char *p1, *p2; +X +X buf = (char *) malloc((db.dsize + 1) * sizeof(char)); +X for (p1 = buf, p2 = db.dptr; *p2 != '\0'; *p1++ = *p2++); +X *p1 = '\0'; +X return buf; +X} +X +X +Xmain(argc, argv) +Xint argc; +Xchar **argv; +X{ +X typedef enum { +X YOW, FETCH, STORE, DELETE, SCAN, REGEXP +X } commands; +X char opt; +X int flags; +X int giveusage = 0; +X int verbose = 0; +X commands what = YOW; +X char *comarg[3]; +X int st_flag = DBM_INSERT; +X int argn; +X DBM *db; +X datum key; +X datum content; +X +X flags = O_RDWR; +X argn = 0; +X +X while ((opt = getopt(argc, argv, "acdfFm:rstvx")) != ':') { +X switch (opt) { +X case 'a': +X what = SCAN; +X break; +X case 'c': +X flags |= O_CREAT; +X break; +X case 'd': +X what = DELETE; +X break; +X case 'f': +X what = FETCH; +X break; +X case 'F': +X what = REGEXP; +X break; +X case 'm': +X flags &= ~(000007); +X if (strcmp(optarg, "r") == 0) +X flags |= O_RDONLY; +X else if (strcmp(optarg, "w") == 0) +X flags |= O_WRONLY; +X else if (strcmp(optarg, "rw") == 0) +X flags |= O_RDWR; +X else { +X fprintf(stderr, "Invalid mode: \"%s\"\n", optarg); +X giveusage = 1; +X } +X break; +X case 'r': +X st_flag = DBM_REPLACE; +X break; +X case 's': +X what = STORE; +X break; +X case 't': +X flags |= O_TRUNC; +X break; +X case 'v': +X verbose = 1; +X break; +X case 'x': +X flags |= O_EXCL; +X break; +X case '!': +X giveusage = 1; +X break; +X case '?': +X if (argn < 3) +X comarg[argn++] = optarg; +X else { +X fprintf(stderr, "Too many arguments.\n"); +X giveusage = 1; +X } +X break; +X } +X } +X +X if (giveusage | what == YOW | argn < 1) { +X fprintf(stderr, "Usage: %s databse [-m r|w|rw] [-crtx] -a|-d|-f|-F|-s [key [content]]\n", argv[0]); +X exit(-1); +X } +X +X if ((db = dbm_open(comarg[0], flags, 0777)) == NULL) { +X fprintf(stderr, "Error opening database \"%s\"\n", comarg[0]); +X exit(-1); +X } +X +X if (argn > 1) +X key = read_datum(comarg[1]); +X if (argn > 2) +X content = read_datum(comarg[2]); +X +X switch (what) { +X +X case SCAN: +X key = dbm_firstkey(db); +X if (dbm_error(db)) { +X fprintf(stderr, "Error when fetching first key\n"); +X goto db_exit; +X } +X while (key.dptr != NULL) { +X content = dbm_fetch(db, key); +X if (dbm_error(db)) { +X fprintf(stderr, "Error when fetching "); +X print_datum(key); +X printf("\n"); +X goto db_exit; +X } +X print_datum(key); +X printf(": "); +X print_datum(content); +X printf("\n"); +X if (dbm_error(db)) { +X fprintf(stderr, "Error when fetching next key\n"); +X goto db_exit; +X } +X key = dbm_nextkey(db); +X } +X break; +X +X case REGEXP: +X if (argn < 2) { +X fprintf(stderr, "Missing regular expression.\n"); +X goto db_exit; +X } +X if (re_comp(comarg[1])) { +X fprintf(stderr, "Invalid regular expression\n"); +X goto db_exit; +X } +X key = dbm_firstkey(db); +X if (dbm_error(db)) { +X fprintf(stderr, "Error when fetching first key\n"); +X goto db_exit; +X } +X while (key.dptr != NULL) { +X if (re_exec(key2s(key))) { +X content = dbm_fetch(db, key); +X if (dbm_error(db)) { +X fprintf(stderr, "Error when fetching "); +X print_datum(key); +X printf("\n"); +X goto db_exit; +X } +X print_datum(key); +X printf(": "); +X print_datum(content); +X printf("\n"); +X if (dbm_error(db)) { +X fprintf(stderr, "Error when fetching next key\n"); +X goto db_exit; +X } +X } +X key = dbm_nextkey(db); +X } +X break; +X +X case FETCH: +X if (argn < 2) { +X fprintf(stderr, "Missing fetch key.\n"); +X goto db_exit; +X } +X content = dbm_fetch(db, key); +X if (dbm_error(db)) { +X fprintf(stderr, "Error when fetching "); +X print_datum(key); +X printf("\n"); +X goto db_exit; +X } +X if (content.dptr == NULL) { +X fprintf(stderr, "Cannot find "); +X print_datum(key); +X printf("\n"); +X goto db_exit; +X } +X print_datum(key); +X printf(": "); +X print_datum(content); +X printf("\n"); +X break; +X +X case DELETE: +X if (argn < 2) { +X fprintf(stderr, "Missing delete key.\n"); +X goto db_exit; +X } +X if (dbm_delete(db, key) || dbm_error(db)) { +X fprintf(stderr, "Error when deleting "); +X print_datum(key); +X printf("\n"); +X goto db_exit; +X } +X if (verbose) { +X print_datum(key); +X printf(": DELETED\n"); +X } +X break; +X +X case STORE: +X if (argn < 3) { +X fprintf(stderr, "Missing key and/or content.\n"); +X goto db_exit; +X } +X if (dbm_store(db, key, content, st_flag) || dbm_error(db)) { +X fprintf(stderr, "Error when storing "); +X print_datum(key); +X printf("\n"); +X goto db_exit; +X } +X if (verbose) { +X print_datum(key); +X printf(": "); +X print_datum(content); +X printf(" STORED\n"); +X } +X break; +X } +X +Xdb_exit: +X dbm_clearerr(db); +X dbm_close(db); +X if (dbm_error(db)) { +X fprintf(stderr, "Error closing database \"%s\"\n", comarg[0]); +X exit(-1); +X } +X} +END_OF_FILE +if test 9799 -ne `wc -c <'dbe.c'`; then + echo shar: \"'dbe.c'\" unpacked with wrong size! +fi +# end of 'dbe.c' +fi +if test -f 'dbm.c' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'dbm.c'\" +else +echo shar: Extracting \"'dbm.c'\" \(2426 characters\) +sed "s/^X//" >'dbm.c' <<'END_OF_FILE' +X/* +X * Copyright (c) 1985 The Regents of the University of California. +X * All rights reserved. +X * +X * Redistribution and use in source and binary forms are permitted +X * provided that the above copyright notice and this paragraph are +X * duplicated in all such forms and that any documentation, +X * advertising materials, and other materials related to such +X * distribution and use acknowledge that the software was developed +X * by the University of California, Berkeley. The name of the +X * University may not be used to endorse or promote products derived +X * from this software without specific prior written permission. +X * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR +X * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +X * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +X */ +X +X#ifndef lint +Xstatic char sccsid[] = "@(#)dbm.c 5.4 (Berkeley) 5/24/89"; +X#endif /* not lint */ +X +X#include "dbm.h" +X +X#define NODB ((DBM *)0) +X +Xstatic DBM *cur_db = NODB; +X +Xstatic char no_db[] = "dbm: no open database\n"; +X +Xdbminit(file) +X char *file; +X{ +X if (cur_db != NODB) +X dbm_close(cur_db); +X +X cur_db = dbm_open(file, 2, 0); +X if (cur_db == NODB) { +X cur_db = dbm_open(file, 0, 0); +X if (cur_db == NODB) +X return (-1); +X } +X return (0); +X} +X +Xlong +Xforder(key) +Xdatum key; +X{ +X if (cur_db == NODB) { +X printf(no_db); +X return (0L); +X } +X return (dbm_forder(cur_db, key)); +X} +X +Xdatum +Xfetch(key) +Xdatum key; +X{ +X datum item; +X +X if (cur_db == NODB) { +X printf(no_db); +X item.dptr = 0; +X return (item); +X } +X return (dbm_fetch(cur_db, key)); +X} +X +Xdelete(key) +Xdatum key; +X{ +X if (cur_db == NODB) { +X printf(no_db); +X return (-1); +X } +X if (dbm_rdonly(cur_db)) +X return (-1); +X return (dbm_delete(cur_db, key)); +X} +X +Xstore(key, dat) +Xdatum key, dat; +X{ +X if (cur_db == NODB) { +X printf(no_db); +X return (-1); +X } +X if (dbm_rdonly(cur_db)) +X return (-1); +X +X return (dbm_store(cur_db, key, dat, DBM_REPLACE)); +X} +X +Xdatum +Xfirstkey() +X{ +X datum item; +X +X if (cur_db == NODB) { +X printf(no_db); +X item.dptr = 0; +X return (item); +X } +X return (dbm_firstkey(cur_db)); +X} +X +Xdatum +Xnextkey(key) +Xdatum key; +X{ +X datum item; +X +X if (cur_db == NODB) { +X printf(no_db); +X item.dptr = 0; +X return (item); +X } +X return (dbm_nextkey(cur_db, key)); +X} +END_OF_FILE +if test 2426 -ne `wc -c <'dbm.c'`; then + echo shar: \"'dbm.c'\" unpacked with wrong size! +fi +# end of 'dbm.c' +fi +if test -f 'dbm.h' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'dbm.h'\" +else +echo shar: Extracting \"'dbm.h'\" \(1186 characters\) +sed "s/^X//" >'dbm.h' <<'END_OF_FILE' +X/* +X * Copyright (c) 1983 The Regents of the University of California. +X * All rights reserved. +X * +X * Redistribution and use in source and binary forms are permitted +X * provided that the above copyright notice and this paragraph are +X * duplicated in all such forms and that any documentation, +X * advertising materials, and other materials related to such +X * distribution and use acknowledge that the software was developed +X * by the University of California, Berkeley. The name of the +X * University may not be used to endorse or promote products derived +X * from this software without specific prior written permission. +X * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR +X * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +X * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +X * +X * @(#)dbm.h 5.2 (Berkeley) 5/24/89 +X */ +X +X#ifndef NULL +X/* +X * this is lunacy, we no longer use it (and never should have +X * unconditionally defined it), but, this whole file is for +X * backwards compatability - someone may rely on this. +X */ +X#define NULL ((char *) 0) +X#endif +X +X#include <ndbm.h> +X +Xdatum fetch(); +Xdatum firstkey(); +Xdatum nextkey(); +END_OF_FILE +if test 1186 -ne `wc -c <'dbm.h'`; then + echo shar: \"'dbm.h'\" unpacked with wrong size! +fi +# end of 'dbm.h' +fi +if test -f 'dbu.c' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'dbu.c'\" +else +echo shar: Extracting \"'dbu.c'\" \(4408 characters\) +sed "s/^X//" >'dbu.c' <<'END_OF_FILE' +X#include <stdio.h> +X#include <sys/file.h> +X#ifdef SDBM +X#include "sdbm.h" +X#else +X#include <ndbm.h> +X#endif +X#include <string.h> +X +X#ifdef BSD42 +X#define strchr index +X#endif +X +Xextern int getopt(); +Xextern char *strchr(); +Xextern void oops(); +X +Xchar *progname; +X +Xstatic int rflag; +Xstatic char *usage = "%s [-R] cat | look |... dbmname"; +X +X#define DERROR 0 +X#define DLOOK 1 +X#define DINSERT 2 +X#define DDELETE 3 +X#define DCAT 4 +X#define DBUILD 5 +X#define DPRESS 6 +X#define DCREAT 7 +X +X#define LINEMAX 8192 +X +Xtypedef struct { +X char *sname; +X int scode; +X int flags; +X} cmd; +X +Xstatic cmd cmds[] = { +X +X "fetch", DLOOK, O_RDONLY, +X "get", DLOOK, O_RDONLY, +X "look", DLOOK, O_RDONLY, +X "add", DINSERT, O_RDWR, +X "insert", DINSERT, O_RDWR, +X "store", DINSERT, O_RDWR, +X "delete", DDELETE, O_RDWR, +X "remove", DDELETE, O_RDWR, +X "dump", DCAT, O_RDONLY, +X "list", DCAT, O_RDONLY, +X "cat", DCAT, O_RDONLY, +X "creat", DCREAT, O_RDWR | O_CREAT | O_TRUNC, +X "new", DCREAT, O_RDWR | O_CREAT | O_TRUNC, +X "build", DBUILD, O_RDWR | O_CREAT, +X "squash", DPRESS, O_RDWR, +X "compact", DPRESS, O_RDWR, +X "compress", DPRESS, O_RDWR +X}; +X +X#define CTABSIZ (sizeof (cmds)/sizeof (cmd)) +X +Xstatic cmd *parse(); +Xstatic void badk(), doit(), prdatum(); +X +Xint +Xmain(argc, argv) +Xint argc; +Xchar *argv[]; +X{ +X int c; +X register cmd *act; +X extern int optind; +X extern char *optarg; +X +X progname = argv[0]; +X +X while ((c = getopt(argc, argv, "R")) != EOF) +X switch (c) { +X case 'R': /* raw processing */ +X rflag++; +X break; +X +X default: +X oops("usage: %s", usage); +X break; +X } +X +X if ((argc -= optind) < 2) +X oops("usage: %s", usage); +X +X if ((act = parse(argv[optind])) == NULL) +X badk(argv[optind]); +X optind++; +X doit(act, argv[optind]); +X return 0; +X} +X +Xstatic void +Xdoit(act, file) +Xregister cmd *act; +Xchar *file; +X{ +X datum key; +X datum val; +X register DBM *db; +X register char *op; +X register int n; +X char *line; +X#ifdef TIME +X long start; +X extern long time(); +X#endif +X +X if ((db = dbm_open(file, act->flags, 0644)) == NULL) +X oops("cannot open: %s", file); +X +X if ((line = (char *) malloc(LINEMAX)) == NULL) +X oops("%s: cannot get memory", "line alloc"); +X +X switch (act->scode) { +X +X case DLOOK: +X while (fgets(line, LINEMAX, stdin) != NULL) { +X n = strlen(line) - 1; +X line[n] = 0; +X key.dptr = line; +X key.dsize = n; +X val = dbm_fetch(db, key); +X if (val.dptr != NULL) { +X prdatum(stdout, val); +X putchar('\n'); +X continue; +X } +X prdatum(stderr, key); +X fprintf(stderr, ": not found.\n"); +X } +X break; +X case DINSERT: +X break; +X case DDELETE: +X while (fgets(line, LINEMAX, stdin) != NULL) { +X n = strlen(line) - 1; +X line[n] = 0; +X key.dptr = line; +X key.dsize = n; +X if (dbm_delete(db, key) == -1) { +X prdatum(stderr, key); +X fprintf(stderr, ": not found.\n"); +X } +X } +X break; +X case DCAT: +X for (key = dbm_firstkey(db); key.dptr != 0; +X key = dbm_nextkey(db)) { +X prdatum(stdout, key); +X putchar('\t'); +X prdatum(stdout, dbm_fetch(db, key)); +X putchar('\n'); +X } +X break; +X case DBUILD: +X#ifdef TIME +X start = time(0); +X#endif +X while (fgets(line, LINEMAX, stdin) != NULL) { +X n = strlen(line) - 1; +X line[n] = 0; +X key.dptr = line; +X if ((op = strchr(line, '\t')) != 0) { +X key.dsize = op - line; +X *op++ = 0; +X val.dptr = op; +X val.dsize = line + n - op; +X } +X else +X oops("bad input; %s", line); +X +X if (dbm_store(db, key, val, DBM_REPLACE) < 0) { +X prdatum(stderr, key); +X fprintf(stderr, ": "); +X oops("store: %s", "failed"); +X } +X } +X#ifdef TIME +X printf("done: %d seconds.\n", time(0) - start); +X#endif +X break; +X case DPRESS: +X break; +X case DCREAT: +X break; +X } +X +X dbm_close(db); +X} +X +Xstatic void +Xbadk(word) +Xchar *word; +X{ +X register int i; +X +X if (progname) +X fprintf(stderr, "%s: ", progname); +X fprintf(stderr, "bad keywd %s. use one of\n", word); +X for (i = 0; i < (int)CTABSIZ; i++) +X fprintf(stderr, "%-8s%c", cmds[i].sname, +X ((i + 1) % 6 == 0) ? '\n' : ' '); +X fprintf(stderr, "\n"); +X exit(1); +X /*NOTREACHED*/ +X} +X +Xstatic cmd * +Xparse(str) +Xregister char *str; +X{ +X register int i = CTABSIZ; +X register cmd *p; +X +X for (p = cmds; i--; p++) +X if (strcmp(p->sname, str) == 0) +X return p; +X return NULL; +X} +X +Xstatic void +Xprdatum(stream, d) +XFILE *stream; +Xdatum d; +X{ +X register int c; +X register char *p = d.dptr; +X register int n = d.dsize; +X +X while (n--) { +X c = *p++ & 0377; +X if (c & 0200) { +X fprintf(stream, "M-"); +X c &= 0177; +X } +X if (c == 0177 || c < ' ') +X fprintf(stream, "^%c", (c == 0177) ? '?' : c + '@'); +X else +X putc(c, stream); +X } +X} +X +X +END_OF_FILE +if test 4408 -ne `wc -c <'dbu.c'`; then + echo shar: \"'dbu.c'\" unpacked with wrong size! +fi +# end of 'dbu.c' +fi +if test -f 'grind' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'grind'\" +else +echo shar: Extracting \"'grind'\" \(201 characters\) +sed "s/^X//" >'grind' <<'END_OF_FILE' +X#!/bin/sh +Xrm -f /tmp/*.dir /tmp/*.pag +Xawk -e '{ +X printf "%s\t", $0 +X for (i = 0; i < 40; i++) +X printf "%s.", $0 +X printf "\n" +X}' < /usr/dict/words | $1 build /tmp/$2 +X +END_OF_FILE +if test 201 -ne `wc -c <'grind'`; then + echo shar: \"'grind'\" unpacked with wrong size! +fi +chmod +x 'grind' +# end of 'grind' +fi +if test -f 'hash.c' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'hash.c'\" +else +echo shar: Extracting \"'hash.c'\" \(922 characters\) +sed "s/^X//" >'hash.c' <<'END_OF_FILE' +X/* +X * sdbm - ndbm work-alike hashed database library +X * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). +X * author: oz@nexus.yorku.ca +X * status: public domain. keep it that way. +X * +X * hashing routine +X */ +X +X#include "sdbm.h" +X/* +X * polynomial conversion ignoring overflows +X * [this seems to work remarkably well, in fact better +X * then the ndbm hash function. Replace at your own risk] +X * use: 65599 nice. +X * 65587 even better. +X */ +Xlong +Xdbm_hash(str, len) +Xregister char *str; +Xregister int len; +X{ +X register unsigned long n = 0; +X +X#ifdef DUFF +X +X#define HASHC n = *str++ + 65599 * n +X +X if (len > 0) { +X register int loop = (len + 8 - 1) >> 3; +X +X switch(len & (8 - 1)) { +X case 0: do { +X HASHC; case 7: HASHC; +X case 6: HASHC; case 5: HASHC; +X case 4: HASHC; case 3: HASHC; +X case 2: HASHC; case 1: HASHC; +X } while (--loop); +X } +X +X } +X#else +X while (len--) +X n = *str++ + 65599 * n; +X#endif +X return n; +X} +END_OF_FILE +if test 922 -ne `wc -c <'hash.c'`; then + echo shar: \"'hash.c'\" unpacked with wrong size! +fi +# end of 'hash.c' +fi +if test -f 'makefile' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'makefile'\" +else +echo shar: Extracting \"'makefile'\" \(1147 characters\) +sed "s/^X//" >'makefile' <<'END_OF_FILE' +X# +X# makefile for public domain ndbm-clone: sdbm +X# DUFF: use duff's device (loop unroll) in parts of the code +X# +XCFLAGS = -O -DSDBM -DDUFF -DBSD42 +X#LDFLAGS = -p +X +XOBJS = sdbm.o pair.o hash.o +XSRCS = sdbm.c pair.c hash.c dbu.c dba.c dbd.c util.c +XHDRS = tune.h sdbm.h pair.h +XMISC = README CHANGES COMPARE sdbm.3 dbe.c dbe.1 dbm.c dbm.h biblio \ +X readme.ms readme.ps +X +Xall: dbu dba dbd dbe +X +Xdbu: dbu.o sdbm util.o +X cc $(LDFLAGS) -o dbu dbu.o util.o libsdbm.a +X +Xdba: dba.o util.o +X cc $(LDFLAGS) -o dba dba.o util.o +Xdbd: dbd.o util.o +X cc $(LDFLAGS) -o dbd dbd.o util.o +Xdbe: dbe.o sdbm +X cc $(LDFLAGS) -o dbe dbe.o libsdbm.a +X +Xsdbm: $(OBJS) +X ar cr libsdbm.a $(OBJS) +X ranlib libsdbm.a +X### cp libsdbm.a /usr/lib/libsdbm.a +X +Xdba.o: sdbm.h +Xdbu.o: sdbm.h +Xutil.o:sdbm.h +X +X$(OBJS): sdbm.h tune.h pair.h +X +X# +X# dbu using berkelezoid ndbm routines [if you have them] for testing +X# +X#x-dbu: dbu.o util.o +X# cc $(CFLAGS) -o x-dbu dbu.o util.o +Xlint: +X lint -abchx $(SRCS) +X +Xclean: +X rm -f *.o mon.out core +X +Xpurge: clean +X rm -f dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag +X +Xshar: +X shar $(MISC) makefile $(SRCS) $(HDRS) >SDBM.SHAR +X +Xreadme: +X nroff -ms readme.ms | col -b >README +END_OF_FILE +if test 1147 -ne `wc -c <'makefile'`; then + echo shar: \"'makefile'\" unpacked with wrong size! +fi +# end of 'makefile' +fi +if test -f 'pair.c' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'pair.c'\" +else +echo shar: Extracting \"'pair.c'\" \(5720 characters\) +sed "s/^X//" >'pair.c' <<'END_OF_FILE' +X/* +X * sdbm - ndbm work-alike hashed database library +X * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). +X * author: oz@nexus.yorku.ca +X * status: public domain. +X * +X * page-level routines +X */ +X +X#ifndef lint +Xstatic char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $"; +X#endif +X +X#include "sdbm.h" +X#include "tune.h" +X#include "pair.h" +X +X#ifndef BSD42 +X#include <memory.h> +X#endif +X +X#define exhash(item) dbm_hash((item).dptr, (item).dsize) +X +X/* +X * forward +X */ +Xstatic int seepair proto((char *, int, char *, int)); +X +X/* +X * page format: +X * +------------------------------+ +X * ino | n | keyoff | datoff | keyoff | +X * +------------+--------+--------+ +X * | datoff | - - - ----> | +X * +--------+---------------------+ +X * | F R E E A R E A | +X * +--------------+---------------+ +X * | <---- - - - | data | +X * +--------+-----+----+----------+ +X * | key | data | key | +X * +--------+----------+----------+ +X * +X * calculating the offsets for free area: if the number +X * of entries (ino[0]) is zero, the offset to the END of +X * the free area is the block size. Otherwise, it is the +X * nth (ino[ino[0]]) entry's offset. +X */ +X +Xint +Xfitpair(pag, need) +Xchar *pag; +Xint need; +X{ +X register int n; +X register int off; +X register int free; +X register short *ino = (short *) pag; +X +X off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; +X free = off - (n + 1) * sizeof(short); +X need += 2 * sizeof(short); +X +X debug(("free %d need %d\n", free, need)); +X +X return need <= free; +X} +X +Xvoid +Xputpair(pag, key, val) +Xchar *pag; +Xdatum key; +Xdatum val; +X{ +X register int n; +X register int off; +X register short *ino = (short *) pag; +X +X off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; +X/* +X * enter the key first +X */ +X off -= key.dsize; +X (void) memcpy(pag + off, key.dptr, key.dsize); +X ino[n + 1] = off; +X/* +X * now the data +X */ +X off -= val.dsize; +X (void) memcpy(pag + off, val.dptr, val.dsize); +X ino[n + 2] = off; +X/* +X * adjust item count +X */ +X ino[0] += 2; +X} +X +Xdatum +Xgetpair(pag, key) +Xchar *pag; +Xdatum key; +X{ +X register int i; +X register int n; +X datum val; +X register short *ino = (short *) pag; +X +X if ((n = ino[0]) == 0) +X return nullitem; +X +X if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) +X return nullitem; +X +X val.dptr = pag + ino[i + 1]; +X val.dsize = ino[i] - ino[i + 1]; +X return val; +X} +X +X#ifdef SEEDUPS +Xint +Xduppair(pag, key) +Xchar *pag; +Xdatum key; +X{ +X register short *ino = (short *) pag; +X return ino[0] > 0 && seepair(pag, ino[0], key.dptr, key.dsize) > 0; +X} +X#endif +X +Xdatum +Xgetnkey(pag, num) +Xchar *pag; +Xint num; +X{ +X datum key; +X register int off; +X register short *ino = (short *) pag; +X +X num = num * 2 - 1; +X if (ino[0] == 0 || num > ino[0]) +X return nullitem; +X +X off = (num > 1) ? ino[num - 1] : PBLKSIZ; +X +X key.dptr = pag + ino[num]; +X key.dsize = off - ino[num]; +X +X return key; +X} +X +Xint +Xdelpair(pag, key) +Xchar *pag; +Xdatum key; +X{ +X register int n; +X register int i; +X register short *ino = (short *) pag; +X +X if ((n = ino[0]) == 0) +X return 0; +X +X if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) +X return 0; +X/* +X * found the key. if it is the last entry +X * [i.e. i == n - 1] we just adjust the entry count. +X * hard case: move all data down onto the deleted pair, +X * shift offsets onto deleted offsets, and adjust them. +X * [note: 0 < i < n] +X */ +X if (i < n - 1) { +X register int m; +X register char *dst = pag + (i == 1 ? PBLKSIZ : ino[i - 1]); +X register char *src = pag + ino[i + 1]; +X register int zoo = dst - src; +X +X debug(("free-up %d ", zoo)); +X/* +X * shift data/keys down +X */ +X m = ino[i + 1] - ino[n]; +X#ifdef DUFF +X#define MOVB *--dst = *--src +X +X if (m > 0) { +X register int loop = (m + 8 - 1) >> 3; +X +X switch (m & (8 - 1)) { +X case 0: do { +X MOVB; case 7: MOVB; +X case 6: MOVB; case 5: MOVB; +X case 4: MOVB; case 3: MOVB; +X case 2: MOVB; case 1: MOVB; +X } while (--loop); +X } +X } +X#else +X#ifdef MEMMOVE +X memmove(dst, src, m); +X#else +X while (m--) +X *--dst = *--src; +X#endif +X#endif +X/* +X * adjust offset index up +X */ +X while (i < n - 1) { +X ino[i] = ino[i + 2] + zoo; +X i++; +X } +X } +X ino[0] -= 2; +X return 1; +X} +X +X/* +X * search for the key in the page. +X * return offset index in the range 0 < i < n. +X * return 0 if not found. +X */ +Xstatic int +Xseepair(pag, n, key, siz) +Xchar *pag; +Xregister int n; +Xregister char *key; +Xregister int siz; +X{ +X register int i; +X register int off = PBLKSIZ; +X register short *ino = (short *) pag; +X +X for (i = 1; i < n; i += 2) { +X if (siz == off - ino[i] && +X memcmp(key, pag + ino[i], siz) == 0) +X return i; +X off = ino[i + 1]; +X } +X return 0; +X} +X +Xvoid +Xsplpage(pag, new, sbit) +Xchar *pag; +Xchar *new; +Xlong sbit; +X{ +X datum key; +X datum val; +X +X register int n; +X register int off = PBLKSIZ; +X char cur[PBLKSIZ]; +X register short *ino = (short *) cur; +X +X (void) memcpy(cur, pag, PBLKSIZ); +X (void) memset(pag, 0, PBLKSIZ); +X (void) memset(new, 0, PBLKSIZ); +X +X n = ino[0]; +X for (ino++; n > 0; ino += 2) { +X key.dptr = cur + ino[0]; +X key.dsize = off - ino[0]; +X val.dptr = cur + ino[1]; +X val.dsize = ino[0] - ino[1]; +X/* +X * select the page pointer (by looking at sbit) and insert +X */ +X (void) putpair((exhash(key) & sbit) ? new : pag, key, val); +X +X off = ino[1]; +X n -= 2; +X } +X +X debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, +X ((short *) new)[0] / 2, +X ((short *) pag)[0] / 2)); +X} +X +X/* +X * check page sanity: +X * number of entries should be something +X * reasonable, and all offsets in the index should be in order. +X * this could be made more rigorous. +X */ +Xint +Xchkpage(pag) +Xchar *pag; +X{ +X register int n; +X register int off; +X register short *ino = (short *) pag; +X +X if ((n = ino[0]) < 0 || n > PBLKSIZ / sizeof(short)) +X return 0; +X +X if (n > 0) { +X off = PBLKSIZ; +X for (ino++; n > 0; ino += 2) { +X if (ino[0] > off || ino[1] > off || +X ino[1] > ino[0]) +X return 0; +X off = ino[1]; +X n -= 2; +X } +X } +X return 1; +X} +END_OF_FILE +if test 5720 -ne `wc -c <'pair.c'`; then + echo shar: \"'pair.c'\" unpacked with wrong size! +fi +# end of 'pair.c' +fi +if test -f 'pair.h' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'pair.h'\" +else +echo shar: Extracting \"'pair.h'\" \(378 characters\) +sed "s/^X//" >'pair.h' <<'END_OF_FILE' +Xextern int fitpair proto((char *, int)); +Xextern void putpair proto((char *, datum, datum)); +Xextern datum getpair proto((char *, datum)); +Xextern int delpair proto((char *, datum)); +Xextern int chkpage proto((char *)); +Xextern datum getnkey proto((char *, int)); +Xextern void splpage proto((char *, char *, long)); +X#ifdef SEEDUPS +Xextern int duppair proto((char *, datum)); +X#endif +END_OF_FILE +if test 378 -ne `wc -c <'pair.h'`; then + echo shar: \"'pair.h'\" unpacked with wrong size! +fi +# end of 'pair.h' +fi +if test -f 'readme.ms' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'readme.ms'\" +else +echo shar: Extracting \"'readme.ms'\" \(11691 characters\) +sed "s/^X//" >'readme.ms' <<'END_OF_FILE' +X.\" tbl | readme.ms | [tn]roff -ms | ... +X.\" note the "C" (courier) and "CB" fonts: you will probably have to +X.\" change these. +X.\" $Id: readme.ms,v 1.1 90/12/13 13:09:15 oz Exp Locker: oz $ +X +X.de P1 +X.br +X.nr dT 4 +X.nf +X.ft C +X.sp .5 +X.nr t \\n(dT*\\w'x'u +X.ta 1u*\\ntu 2u*\\ntu 3u*\\ntu 4u*\\ntu 5u*\\ntu 6u*\\ntu 7u*\\ntu 8u*\\ntu 9u*\\ntu 10u*\\ntu 11u*\\ntu 12u*\\ntu 13u*\\ntu 14u*\\ntu +X.. +X.de P2 +X.br +X.ft 1 +X.br +X.sp .5 +X.br +X.fi +X.. +X.\" CW uses the typewriter/courier font. +X.de CW +X\fC\\$1\\fP\\$2 +X.. +X +X.\" Footnote numbering [by Henry Spencer] +X.\" <text>\*f for a footnote number.. +X.\" .FS +X.\" \*F <footnote text> +X.\" .FE +X.\" +X.ds f \\u\\s-2\\n+f\\s+2\\d +X.nr f 0 1 +X.ds F \\n+F. +X.nr F 0 1 +X +X.ND +X.LP +X.TL +X\fIsdbm\fP \(em Substitute DBM +X.br +Xor +X.br +XBerkeley \fIndbm\fP for Every UN*X\** Made Simple +X.AU +XOzan (oz) Yigit +X.AI +XThe Guild of PD Software Toolmakers +XToronto - Canada +X.sp +Xoz@nexus.yorku.ca +X.LP +X.FS +XUN*X is not a trademark of any (dis)organization. +X.FE +X.sp 2 +X\fIImplementation is the sincerest form of flattery. \(em L. Peter Deutsch\fP +X.SH +XA The Clone of the \fIndbm\fP library +X.PP +XThe sources accompanying this notice \(em \fIsdbm\fP \(em constitute +Xthe first public release (Dec. 1990) of a complete clone of +Xthe Berkeley UN*X \fIndbm\fP library. The \fIsdbm\fP library is meant to +Xclone the proven functionality of \fIndbm\fP as closely as possible, +Xincluding a few improvements. It is practical, easy to understand, and +Xcompatible. +XThe \fIsdbm\fP library is not derived from any licensed, proprietary or +Xcopyrighted software. +X.PP +XThe \fIsdbm\fP implementation is based on a 1978 algorithm +X[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''. +XIn the course of searching for a substitute for \fIndbm\fP, I +Xprototyped three different external-hashing algorithms [Lar78, Fag79, Lit80] +Xand ultimately chose Larson's algorithm as a basis of the \fIsdbm\fP +Ximplementation. The Bell Labs +X\fIdbm\fP (and therefore \fIndbm\fP) is based on an algorithm invented by +XKen Thompson, [Tho90, Tor87] and predates Larson's work. +X.PP +XThe \fIsdbm\fR programming interface is totally compatible +Xwith \fIndbm\fP and includes a slight improvement in database initialization. +XIt is also expected to be binary-compatible under most UN*X versions that +Xsupport the \fIndbm\fP library. +X.PP +XThe \fIsdbm\fP implementation shares the shortcomings of the \fIndbm\fP +Xlibrary, as a side effect of various simplifications to the original Larson +Xalgorithm. It does produce \fIholes\fP in the page file as it writes +Xpages past the end of file. (Larson's paper include a clever solution to +Xthis problem that is a result of using the hash value directly as a block +Xaddress.) On the other hand, extensive tests seem to indicate that \fIsdbm\fP +Xcreates fewer holes in general, and the resulting pagefiles are +Xsmaller. The \fIsdbm\fP implementation is also faster than \fIndbm\fP +Xin database creation. +XUnlike the \fIndbm\fP, the \fIsdbm\fP +X.CW store +Xoperation will not ``wander away'' trying to split its +Xdata pages to insert a datum that \fIcannot\fP (due to elaborate worst-case +Xsituations) be inserted. (It will fail after a pre-defined number of attempts.) +X.SH +XImportant Compatibility Warning +X.PP +XThe \fIsdbm\fP and \fIndbm\fP +Xlibraries \fIcannot\fP share databases: one cannot read the (dir/pag) +Xdatabase created by the other. This is due to the differences +Xbetween the \fIndbm\fP and \fIsdbm\fP algorithms\**, +X.FS +XTorek's discussion [Tor87] +Xindicates that \fIdbm/ndbm\fP implementations use the hash +Xvalue to traverse the radix trie differently than \fIsdbm\fP +Xand as a result, the page indexes are generated in \fIdifferent\fP order. +XFor more information, send e-mail to the author. +X.FE +Xand the hash functions +Xused. +XIt is easy to convert between the \fIdbm/ndbm\fP databases and \fIsdbm\fP +Xby ignoring the index completely: see +X.CW dbd , +X.CW dbu +Xetc. +X.R +X.LP +X.SH +XNotice of Intellectual Property +X.LP +X\fIThe entire\fP sdbm \fIlibrary package, as authored by me,\fP Ozan S. Yigit, +X\fIis hereby placed in the public domain.\fP As such, the author is not +Xresponsible for the consequences of use of this software, no matter how +Xawful, even if they arise from defects in it. There is no expressed or +Ximplied warranty for the \fIsdbm\fP library. +X.PP +XSince the \fIsdbm\fP +Xlibrary package is in the public domain, this \fIoriginal\fP +Xrelease or any additional public-domain releases of the modified original +Xcannot possibly (by definition) be withheld from you. Also by definition, +XYou (singular) have all the rights to this code (including the right to +Xsell without permission, the right to hoard\** +X.FS +XYou cannot really hoard something that is available to the public at +Xlarge, but try if it makes you feel any better. +X.FE +Xand the right to do other icky things as +Xyou see fit) but those rights are also granted to everyone else. +X.PP +XPlease note that all previous distributions of this software contained +Xa copyright (which is now dropped) to protect its +Xorigins and its current public domain status against any possible claims +Xand/or challenges. +X.SH +XAcknowledgments +X.PP +XMany people have been very helpful and supportive. A partial list would +Xnecessarily include Rayan Zacherissen (who contributed the man page, +Xand also hacked a MMAP version of \fIsdbm\fP), +XArnold Robbins, Chris Lewis, +XBill Davidsen, Henry Spencer, Geoff Collyer, Rich Salz (who got me started +Xin the first place), Johannes Ruschein +X(who did the minix port) and David Tilbrook. I thank you all. +X.SH +XDistribution Manifest and Notes +X.LP +XThis distribution of \fIsdbm\fP includes (at least) the following: +X.P1 +X CHANGES change log +X README this file. +X biblio a small bibliography on external hashing +X dba.c a crude (n/s)dbm page file analyzer +X dbd.c a crude (n/s)dbm page file dumper (for conversion) +X dbe.1 man page for dbe.c +X dbe.c Janick's database editor +X dbm.c a dbm library emulation wrapper for ndbm/sdbm +X dbm.h header file for the above +X dbu.c a crude db management utility +X hash.c hashing function +X makefile guess. +X pair.c page-level routines (posted earlier) +X pair.h header file for the above +X readme.ms troff source for the README file +X sdbm.3 man page +X sdbm.c the real thing +X sdbm.h header file for the above +X tune.h place for tuning & portability thingies +X util.c miscellaneous +X.P2 +X.PP +X.CW dbu +Xis a simple database manipulation program\** that tries to look +X.FS +XThe +X.CW dbd , +X.CW dba , +X.CW dbu +Xutilities are quick hacks and are not fit for production use. They were +Xdeveloped late one night, just to test out \fIsdbm\fP, and convert some +Xdatabases. +X.FE +Xlike Bell Labs' +X.CW cbt +Xutility. It is currently incomplete in functionality. +XI use +X.CW dbu +Xto test out the routines: it takes (from stdin) tab separated +Xkey/value pairs for commands like +X.CW build +Xor +X.CW insert +Xor takes keys for +Xcommands like +X.CW delete +Xor +X.CW look . +X.P1 +X dbu <build|creat|look|insert|cat|delete> dbmfile +X.P2 +X.PP +X.CW dba +Xis a crude analyzer of \fIdbm/sdbm/ndbm\fP +Xpage files. It scans the entire +Xpage file, reporting page level statistics, and totals at the end. +X.PP +X.CW dbd +Xis a crude dump program for \fIdbm/ndbm/sdbm\fP +Xdatabases. It ignores the +Xbitmap, and dumps the data pages in sequence. It can be used to create +Xinput for the +X.CW dbu +Xutility. +XNote that +X.CW dbd +Xwill skip any NULLs in the key and data +Xfields, thus is unsuitable to convert some peculiar databases that +Xinsist in including the terminating null. +X.PP +XI have also included a copy of the +X.CW dbe +X(\fIndbm\fP DataBase Editor) by Janick Bergeron [janick@bnr.ca] for +Xyour pleasure. You may find it more useful than the little +X.CW dbu +Xutility. +X.PP +X.CW dbm.[ch] +Xis a \fIdbm\fP library emulation on top of \fIndbm\fP +X(and hence suitable for \fIsdbm\fP). Written by Robert Elz. +X.PP +XThe \fIsdbm\fP +Xlibrary has been around in beta test for quite a long time, and from whatever +Xlittle feedback I received (maybe no news is good news), I believe it has been +Xfunctioning without any significant problems. I would, of course, appreciate +Xall fixes and/or improvements. Portability enhancements would especially be +Xuseful. +X.SH +XImplementation Issues +X.PP +XHash functions: +XThe algorithm behind \fIsdbm\fP implementation needs a good bit-scrambling +Xhash function to be effective. I ran into a set of constants for a simple +Xhash function that seem to help \fIsdbm\fP perform better than \fIndbm\fP +Xfor various inputs: +X.P1 +X /* +X * polynomial conversion ignoring overflows +X * 65599 nice. 65587 even better. +X */ +X long +X dbm_hash(char *str, int len) { +X register unsigned long n = 0; +X +X while (len--) +X n = n * 65599 + *str++; +X return n; +X } +X.P2 +X.PP +XThere may be better hash functions for the purposes of dynamic hashing. +XTry your favorite, and check the pagefile. If it contains too many pages +Xwith too many holes, (in relation to this one for example) or if +X\fIsdbm\fP +Xsimply stops working (fails after +X.CW SPLTMAX +Xattempts to split) when you feed your +XNEWS +X.CW history +Xfile to it, you probably do not have a good hashing function. +XIf you do better (for different types of input), I would like to know +Xabout the function you use. +X.PP +XBlock sizes: It seems (from various tests on a few machines) that a page +Xfile block size +X.CW PBLKSIZ +Xof 1024 is by far the best for performance, but +Xthis also happens to limit the size of a key/value pair. Depending on your +Xneeds, you may wish to increase the page size, and also adjust +X.CW PAIRMAX +X(the maximum size of a key/value pair allowed: should always be at least +Xthree words smaller than +X.CW PBLKSIZ .) +Xaccordingly. The system-wide version of the library +Xshould probably be +Xconfigured with 1024 (distribution default), as this appears to be sufficient +Xfor most common uses of \fIsdbm\fP. +X.SH +XPortability +X.PP +XThis package has been tested in many different UN*Xes even including minix, +Xand appears to be reasonably portable. This does not mean it will port +Xeasily to non-UN*X systems. +X.SH +XNotes and Miscellaneous +X.PP +XThe \fIsdbm\fP is not a very complicated package, at least not after you +Xfamiliarize yourself with the literature on external hashing. There are +Xother interesting algorithms in existence that ensure (approximately) +Xsingle-read access to a data value associated with any key. These are +Xdirectory-less schemes such as \fIlinear hashing\fP [Lit80] (+ Larson +Xvariations), \fIspiral storage\fP [Mar79] or directory schemes such as +X\fIextensible hashing\fP [Fag79] by Fagin et al. I do hope these sources +Xprovide a reasonable playground for experimentation with other algorithms. +XSee the June 1988 issue of ACM Computing Surveys [Enb88] for an +Xexcellent overview of the field. +X.PG +X.SH +XReferences +X.LP +X.IP [Lar78] 4m +XP.-A. Larson, +X``Dynamic Hashing'', \fIBIT\fP, vol. 18, pp. 184-201, 1978. +X.IP [Tho90] 4m +XKen Thompson, \fIprivate communication\fP, Nov. 1990 +X.IP [Lit80] 4m +XW. Litwin, +X`` Linear Hashing: A new tool for file and table addressing'', +X\fIProceedings of the 6th Conference on Very Large Dabatases (Montreal)\fP, +Xpp. 212-223, Very Large Database Foundation, Saratoga, Calif., 1980. +X.IP [Fag79] 4m +XR. Fagin, J. Nievergelt, N. Pippinger, and H. R. Strong, +X``Extendible Hashing - A Fast Access Method for Dynamic Files'', +X\fIACM Trans. Database Syst.\fP, vol. 4, no.3, pp. 315-344, Sept. 1979. +X.IP [Wal84] 4m +XRich Wales, +X``Discussion of "dbm" data base system'', \fIUSENET newsgroup unix.wizards\fP, +XJan. 1984. +X.IP [Tor87] 4m +XChris Torek, +X``Re: dbm.a and ndbm.a archives'', \fIUSENET newsgroup comp.unix\fP, +X1987. +X.IP [Mar79] 4m +XG. N. Martin, +X``Spiral Storage: Incrementally Augmentable Hash Addressed Storage'', +X\fITechnical Report #27\fP, University of Varwick, Coventry, U.K., 1979. +X.IP [Enb88] 4m +XR. J. Enbody and H. C. Du, +X``Dynamic Hashing Schemes'',\fIACM Computing Surveys\fP, +Xvol. 20, no. 2, pp. 85-113, June 1988. +END_OF_FILE +if test 11691 -ne `wc -c <'readme.ms'`; then + echo shar: \"'readme.ms'\" unpacked with wrong size! +fi +# end of 'readme.ms' +fi +if test -f 'readme.ps' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'readme.ps'\" +else +echo shar: Extracting \"'readme.ps'\" \(33302 characters\) +sed "s/^X//" >'readme.ps' <<'END_OF_FILE' +X%!PS-Adobe-1.0 +X%%Creator: yetti:oz (Ozan Yigit) +X%%Title: stdin (ditroff) +X%%CreationDate: Thu Dec 13 15:56:08 1990 +X%%EndComments +X% lib/psdit.pro -- prolog for psdit (ditroff) files +X% Copyright (c) 1984, 1985 Adobe Systems Incorporated. All Rights Reserved. +X% last edit: shore Sat Nov 23 20:28:03 1985 +X% RCSID: $Header: psdit.pro,v 2.1 85/11/24 12:19:43 shore Rel $ +X +X/$DITroff 140 dict def $DITroff begin +X/fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def +X/xi {0 72 11 mul translate 72 resolution div dup neg scale 0 0 moveto +X /fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def F +X /pagesave save def}def +X/PB{save /psv exch def currentpoint translate +X resolution 72 div dup neg scale 0 0 moveto}def +X/PE{psv restore}def +X/arctoobig 90 def /arctoosmall .05 def +X/m1 matrix def /m2 matrix def /m3 matrix def /oldmat matrix def +X/tan{dup sin exch cos div}def +X/point{resolution 72 div mul}def +X/dround {transform round exch round exch itransform}def +X/xT{/devname exch def}def +X/xr{/mh exch def /my exch def /resolution exch def}def +X/xp{}def +X/xs{docsave restore end}def +X/xt{}def +X/xf{/fontname exch def /slotno exch def fontnames slotno get fontname eq not +X {fonts slotno fontname findfont put fontnames slotno fontname put}if}def +X/xH{/fontheight exch def F}def +X/xS{/fontslant exch def F}def +X/s{/fontsize exch def /fontheight fontsize def F}def +X/f{/fontnum exch def F}def +X/F{fontheight 0 le {/fontheight fontsize def}if +X fonts fontnum get fontsize point 0 0 fontheight point neg 0 0 m1 astore +X fontslant 0 ne{1 0 fontslant tan 1 0 0 m2 astore m3 concatmatrix}if +X makefont setfont .04 fontsize point mul 0 dround pop setlinewidth}def +X/X{exch currentpoint exch pop moveto show}def +X/N{3 1 roll moveto show}def +X/Y{exch currentpoint pop exch moveto show}def +X/S{show}def +X/ditpush{}def/ditpop{}def +X/AX{3 -1 roll currentpoint exch pop moveto 0 exch ashow}def +X/AN{4 2 roll moveto 0 exch ashow}def +X/AY{3 -1 roll currentpoint pop exch moveto 0 exch ashow}def +X/AS{0 exch ashow}def +X/MX{currentpoint exch pop moveto}def +X/MY{currentpoint pop exch moveto}def +X/MXY{moveto}def +X/cb{pop}def % action on unknown char -- nothing for now +X/n{}def/w{}def +X/p{pop showpage pagesave restore /pagesave save def}def +X/abspoint{currentpoint exch pop add exch currentpoint pop add exch}def +X/distance{dup mul exch dup mul add sqrt}def +X/dstroke{currentpoint stroke moveto}def +X/Dl{2 copy gsave rlineto stroke grestore rmoveto}def +X/arcellipse{/diamv exch def /diamh exch def oldmat currentmatrix pop +X currentpoint translate 1 diamv diamh div scale /rad diamh 2 div def +X currentpoint exch rad add exch rad -180 180 arc oldmat setmatrix}def +X/Dc{dup arcellipse dstroke}def +X/De{arcellipse dstroke}def +X/Da{/endv exch def /endh exch def /centerv exch def /centerh exch def +X /cradius centerv centerv mul centerh centerh mul add sqrt def +X /eradius endv endv mul endh endh mul add sqrt def +X /endang endv endh atan def +X /startang centerv neg centerh neg atan def +X /sweep startang endang sub dup 0 lt{360 add}if def +X sweep arctoobig gt +X {/midang startang sweep 2 div sub def /midrad cradius eradius add 2 div def +X /midh midang cos midrad mul def /midv midang sin midrad mul def +X midh neg midv neg endh endv centerh centerv midh midv Da +X currentpoint moveto Da} +X {sweep arctoosmall ge +X {/controldelt 1 sweep 2 div cos sub 3 sweep 2 div sin mul div 4 mul def +X centerv neg controldelt mul centerh controldelt mul +X endv neg controldelt mul centerh add endh add +X endh controldelt mul centerv add endv add +X centerh endh add centerv endv add rcurveto dstroke} +X {centerh endh add centerv endv add rlineto dstroke}ifelse}ifelse}def +X +X/Barray 200 array def % 200 values in a wiggle +X/D~{mark}def +X/D~~{counttomark Barray exch 0 exch getinterval astore /Bcontrol exch def pop +X /Blen Bcontrol length def Blen 4 ge Blen 2 mod 0 eq and +X {Bcontrol 0 get Bcontrol 1 get abspoint /Ycont exch def /Xcont exch def +X Bcontrol 0 2 copy get 2 mul put Bcontrol 1 2 copy get 2 mul put +X Bcontrol Blen 2 sub 2 copy get 2 mul put +X Bcontrol Blen 1 sub 2 copy get 2 mul put +X /Ybi /Xbi currentpoint 3 1 roll def def 0 2 Blen 4 sub +X {/i exch def +X Bcontrol i get 3 div Bcontrol i 1 add get 3 div +X Bcontrol i get 3 mul Bcontrol i 2 add get add 6 div +X Bcontrol i 1 add get 3 mul Bcontrol i 3 add get add 6 div +X /Xbi Xcont Bcontrol i 2 add get 2 div add def +X /Ybi Ycont Bcontrol i 3 add get 2 div add def +X /Xcont Xcont Bcontrol i 2 add get add def +X /Ycont Ycont Bcontrol i 3 add get add def +X Xbi currentpoint pop sub Ybi currentpoint exch pop sub rcurveto +X }for dstroke}if}def +Xend +X/ditstart{$DITroff begin +X /nfonts 60 def % NFONTS makedev/ditroff dependent! +X /fonts[nfonts{0}repeat]def +X /fontnames[nfonts{()}repeat]def +X/docsave save def +X}def +X +X% character outcalls +X/oc {/pswid exch def /cc exch def /name exch def +X /ditwid pswid fontsize mul resolution mul 72000 div def +X /ditsiz fontsize resolution mul 72 div def +X ocprocs name known{ocprocs name get exec}{name cb} +X ifelse}def +X/fractm [.65 0 0 .6 0 0] def +X/fraction +X {/fden exch def /fnum exch def gsave /cf currentfont def +X cf fractm makefont setfont 0 .3 dm 2 copy neg rmoveto +X fnum show rmoveto currentfont cf setfont(\244)show setfont fden show +X grestore ditwid 0 rmoveto} def +X/oce {grestore ditwid 0 rmoveto}def +X/dm {ditsiz mul}def +X/ocprocs 50 dict def ocprocs begin +X(14){(1)(4)fraction}def +X(12){(1)(2)fraction}def +X(34){(3)(4)fraction}def +X(13){(1)(3)fraction}def +X(23){(2)(3)fraction}def +X(18){(1)(8)fraction}def +X(38){(3)(8)fraction}def +X(58){(5)(8)fraction}def +X(78){(7)(8)fraction}def +X(sr){gsave 0 .06 dm rmoveto(\326)show oce}def +X(is){gsave 0 .15 dm rmoveto(\362)show oce}def +X(->){gsave 0 .02 dm rmoveto(\256)show oce}def +X(<-){gsave 0 .02 dm rmoveto(\254)show oce}def +X(==){gsave 0 .05 dm rmoveto(\272)show oce}def +Xend +X +X% an attempt at a PostScript FONT to implement ditroff special chars +X% this will enable us to +X% cache the little buggers +X% generate faster, more compact PS out of psdit +X% confuse everyone (including myself)! +X50 dict dup begin +X/FontType 3 def +X/FontName /DIThacks def +X/FontMatrix [.001 0 0 .001 0 0] def +X/FontBBox [-260 -260 900 900] def% a lie but ... +X/Encoding 256 array def +X0 1 255{Encoding exch /.notdef put}for +XEncoding +X dup 8#040/space put %space +X dup 8#110/rc put %right ceil +X dup 8#111/lt put %left top curl +X dup 8#112/bv put %bold vert +X dup 8#113/lk put %left mid curl +X dup 8#114/lb put %left bot curl +X dup 8#115/rt put %right top curl +X dup 8#116/rk put %right mid curl +X dup 8#117/rb put %right bot curl +X dup 8#120/rf put %right floor +X dup 8#121/lf put %left floor +X dup 8#122/lc put %left ceil +X dup 8#140/sq put %square +X dup 8#141/bx put %box +X dup 8#142/ci put %circle +X dup 8#143/br put %box rule +X dup 8#144/rn put %root extender +X dup 8#145/vr put %vertical rule +X dup 8#146/ob put %outline bullet +X dup 8#147/bu put %bullet +X dup 8#150/ru put %rule +X dup 8#151/ul put %underline +X pop +X/DITfd 100 dict def +X/BuildChar{0 begin +X /cc exch def /fd exch def +X /charname fd /Encoding get cc get def +X /charwid fd /Metrics get charname get def +X /charproc fd /CharProcs get charname get def +X charwid 0 fd /FontBBox get aload pop setcachedevice +X 2 setlinejoin 40 setlinewidth +X newpath 0 0 moveto gsave charproc grestore +X end}def +X/BuildChar load 0 DITfd put +X%/UniqueID 5 def +X/CharProcs 50 dict def +XCharProcs begin +X/space{}def +X/.notdef{}def +X/ru{500 0 rls}def +X/rn{0 840 moveto 500 0 rls}def +X/vr{0 800 moveto 0 -770 rls}def +X/bv{0 800 moveto 0 -1000 rls}def +X/br{0 750 moveto 0 -1000 rls}def +X/ul{0 -140 moveto 500 0 rls}def +X/ob{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath stroke}def +X/bu{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath fill}def +X/sq{80 0 rmoveto currentpoint dround newpath moveto +X 640 0 rlineto 0 640 rlineto -640 0 rlineto closepath stroke}def +X/bx{80 0 rmoveto currentpoint dround newpath moveto +X 640 0 rlineto 0 640 rlineto -640 0 rlineto closepath fill}def +X/ci{500 360 rmoveto currentpoint newpath 333 0 360 arc +X 50 setlinewidth stroke}def +X +X/lt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 add exch s4 a4p stroke}def +X/lb{0 800 moveto 0 -550 rlineto currx -200 2cx s4 add exch s4 a4p stroke}def +X/rt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 sub exch s4 a4p stroke}def +X/rb{0 800 moveto 0 -500 rlineto currx -200 2cx s4 sub exch s4 a4p stroke}def +X/lk{0 800 moveto 0 300 -300 300 s4 arcto pop pop 1000 sub +X 0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def +X/rk{0 800 moveto 0 300 s2 300 s4 arcto pop pop 1000 sub +X 0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def +X/lf{0 800 moveto 0 -1000 rlineto s4 0 rls}def +X/rf{0 800 moveto 0 -1000 rlineto s4 neg 0 rls}def +X/lc{0 -200 moveto 0 1000 rlineto s4 0 rls}def +X/rc{0 -200 moveto 0 1000 rlineto s4 neg 0 rls}def +Xend +X +X/Metrics 50 dict def Metrics begin +X/.notdef 0 def +X/space 500 def +X/ru 500 def +X/br 0 def +X/lt 416 def +X/lb 416 def +X/rt 416 def +X/rb 416 def +X/lk 416 def +X/rk 416 def +X/rc 416 def +X/lc 416 def +X/rf 416 def +X/lf 416 def +X/bv 416 def +X/ob 350 def +X/bu 350 def +X/ci 750 def +X/bx 750 def +X/sq 750 def +X/rn 500 def +X/ul 500 def +X/vr 0 def +Xend +X +XDITfd begin +X/s2 500 def /s4 250 def /s3 333 def +X/a4p{arcto pop pop pop pop}def +X/2cx{2 copy exch}def +X/rls{rlineto stroke}def +X/currx{currentpoint pop}def +X/dround{transform round exch round exch itransform} def +Xend +Xend +X/DIThacks exch definefont pop +Xditstart +X(psc)xT +X576 1 1 xr +X1(Times-Roman)xf 1 f +X2(Times-Italic)xf 2 f +X3(Times-Bold)xf 3 f +X4(Times-BoldItalic)xf 4 f +X5(Helvetica)xf 5 f +X6(Helvetica-Bold)xf 6 f +X7(Courier)xf 7 f +X8(Courier-Bold)xf 8 f +X9(Symbol)xf 9 f +X10(DIThacks)xf 10 f +X10 s +X1 f +Xxi +X%%EndProlog +X +X%%Page: 1 1 +X10 s 0 xH 0 xS 1 f +X8 s +X2 f +X12 s +X1778 672(sdbm)N +X3 f +X2004(\320)X +X2124(Substitute)X +X2563(DBM)X +X2237 768(or)N +X1331 864(Berkeley)N +X2 f +X1719(ndbm)X +X3 f +X1956(for)X +X2103(Every)X +X2373(UN*X)X +X1 f +X10 s +X2628 832(1)N +X3 f +X12 s +X2692 864(Made)N +X2951(Simple)X +X2 f +X10 s +X2041 1056(Ozan)N +X2230(\(oz\))X +X2375(Yigit)X +X1 f +X1658 1200(The)N +X1803(Guild)X +X2005(of)X +X2092(PD)X +X2214(Software)X +X2524(Toolmakers)X +X2000 1296(Toronto)N +X2278(-)X +X2325(Canada)X +X1965 1488(oz@nexus.yorku.ca)N +X2 f +X555 1804(Implementation)N +X1078(is)X +X1151(the)X +X1269(sincerest)X +X1574(form)X +X1745(of)X +X1827(\257attery.)X +X2094(\320)X +X2185(L.)X +X2269(Peter)X +X2463(Deutsch)X +X3 f +X555 1996(A)N +X633(The)X +X786(Clone)X +X1006(of)X +X1093(the)X +X2 f +X1220(ndbm)X +X3 f +X1418(library)X +X1 f +X755 2120(The)N +X903(sources)X +X1167(accompanying)X +X1658(this)X +X1796(notice)X +X2015(\320)X +X2 f +X2118(sdbm)X +X1 f +X2309(\320)X +X2411(constitute)X +X2744(the)X +X2864(\256rst)X +X3010(public)X +X3232(release)X +X3478(\(Dec.)X +X3677(1990\))X +X3886(of)X +X3975(a)X +X555 2216(complete)N +X874(clone)X +X1073(of)X +X1165(the)X +X1288(Berkeley)X +X1603(UN*X)X +X2 f +X1842(ndbm)X +X1 f +X2045(library.)X +X2304(The)X +X2 f +X2454(sdbm)X +X1 f +X2648(library)X +X2887(is)X +X2965(meant)X +X3186(to)X +X3273(clone)X +X3472(the)X +X3594(proven)X +X3841(func-)X +X555 2312(tionality)N +X846(of)X +X2 f +X938(ndbm)X +X1 f +X1141(as)X +X1233(closely)X +X1485(as)X +X1576(possible,)X +X1882(including)X +X2208(a)X +X2268(few)X +X2413(improvements.)X +X2915(It)X +X2988(is)X +X3065(practical,)X +X3386(easy)X +X3553(to)X +X3639(understand,)X +X555 2408(and)N +X691(compatible.)X +X1107(The)X +X2 f +X1252(sdbm)X +X1 f +X1441(library)X +X1675(is)X +X1748(not)X +X1870(derived)X +X2131(from)X +X2307(any)X +X2443(licensed,)X +X2746(proprietary)X +X3123(or)X +X3210(copyrighted)X +X3613(software.)X +X755 2532(The)N +X2 f +X910(sdbm)X +X1 f +X1109(implementation)X +X1641(is)X +X1723(based)X +X1935(on)X +X2044(a)X +X2109(1978)X +X2298(algorithm)X +X2638([Lar78])X +X2913(by)X +X3022(P.-A.)X +X3220(\(Paul\))X +X3445(Larson)X +X3697(known)X +X3944(as)X +X555 2628(``Dynamic)N +X934(Hashing''.)X +X1326(In)X +X1424(the)X +X1553(course)X +X1794(of)X +X1892(searching)X +X2231(for)X +X2355(a)X +X2421(substitute)X +X2757(for)X +X2 f +X2881(ndbm)X +X1 f +X3059(,)X +X3109(I)X +X3166(prototyped)X +X3543(three)X +X3734(different)X +X555 2724(external-hashing)N +X1119(algorithms)X +X1490([Lar78,)X +X1758(Fag79,)X +X2007(Lit80])X +X2236(and)X +X2381(ultimately)X +X2734(chose)X +X2946(Larson's)X +X3256(algorithm)X +X3596(as)X +X3692(a)X +X3756(basis)X +X3944(of)X +X555 2820(the)N +X2 f +X680(sdbm)X +X1 f +X875(implementation.)X +X1423(The)X +X1574(Bell)X +X1733(Labs)X +X2 f +X1915(dbm)X +X1 f +X2079(\(and)X +X2248(therefore)X +X2 f +X2565(ndbm)X +X1 f +X2743(\))X +X2796(is)X +X2875(based)X +X3084(on)X +X3190(an)X +X3292(algorithm)X +X3629(invented)X +X3931(by)X +X555 2916(Ken)N +X709(Thompson,)X +X1091([Tho90,)X +X1367(Tor87])X +X1610(and)X +X1746(predates)X +X2034(Larson's)X +X2335(work.)X +X755 3040(The)N +X2 f +X903(sdbm)X +X1 f +X1095(programming)X +X1553(interface)X +X1857(is)X +X1932(totally)X +X2158(compatible)X +X2536(with)X +X2 f +X2700(ndbm)X +X1 f +X2900(and)X +X3038(includes)X +X3327(a)X +X3385(slight)X +X3584(improvement)X +X555 3136(in)N +X641(database)X +X942(initialization.)X +X1410(It)X +X1483(is)X +X1560(also)X +X1713(expected)X +X2023(to)X +X2109(be)X +X2208(binary-compatible)X +X2819(under)X +X3025(most)X +X3203(UN*X)X +X3440(versions)X +X3730(that)X +X3873(sup-)X +X555 3232(port)N +X704(the)X +X2 f +X822(ndbm)X +X1 f +X1020(library.)X +X755 3356(The)N +X2 f +X909(sdbm)X +X1 f +X1107(implementation)X +X1638(shares)X +X1868(the)X +X1995(shortcomings)X +X2455(of)X +X2551(the)X +X2 f +X2678(ndbm)X +X1 f +X2885(library,)X +X3148(as)X +X3244(a)X +X3309(side)X +X3467(effect)X +X3680(of)X +X3775(various)X +X555 3452(simpli\256cations)N +X1046(to)X +X1129(the)X +X1248(original)X +X1518(Larson)X +X1762(algorithm.)X +X2114(It)X +X2183(does)X +X2350(produce)X +X2 f +X2629(holes)X +X1 f +X2818(in)X +X2900(the)X +X3018(page)X +X3190(\256le)X +X3312(as)X +X3399(it)X +X3463(writes)X +X3679(pages)X +X3882(past)X +X555 3548(the)N +X680(end)X +X823(of)X +X917(\256le.)X +X1066(\(Larson's)X +X1400(paper)X +X1605(include)X +X1867(a)X +X1929(clever)X +X2152(solution)X +X2435(to)X +X2523(this)X +X2664(problem)X +X2957(that)X +X3103(is)X +X3182(a)X +X3244(result)X +X3448(of)X +X3541(using)X +X3740(the)X +X3864(hash)X +X555 3644(value)N +X758(directly)X +X1032(as)X +X1128(a)X +X1193(block)X +X1400(address.\))X +X1717(On)X +X1844(the)X +X1971(other)X +X2165(hand,)X +X2370(extensive)X +X2702(tests)X +X2873(seem)X +X3067(to)X +X3158(indicate)X +X3441(that)X +X2 f +X3590(sdbm)X +X1 f +X3787(creates)X +X555 3740(fewer)N +X762(holes)X +X954(in)X +X1039(general,)X +X1318(and)X +X1456(the)X +X1576(resulting)X +X1878(page\256les)X +X2185(are)X +X2306(smaller.)X +X2584(The)X +X2 f +X2731(sdbm)X +X1 f +X2922(implementation)X +X3446(is)X +X3521(also)X +X3672(faster)X +X3873(than)X +X2 f +X555 3836(ndbm)N +X1 f +X757(in)X +X843(database)X +X1144(creation.)X +X1467(Unlike)X +X1709(the)X +X2 f +X1831(ndbm)X +X1 f +X2009(,)X +X2053(the)X +X2 f +X2175(sdbm)X +X7 f +X2396(store)X +X1 f +X2660(operation)X +X2987(will)X +X3134(not)X +X3259(``wander)X +X3573(away'')X +X3820(trying)X +X555 3932(to)N +X642(split)X +X804(its)X +X904(data)X +X1063(pages)X +X1271(to)X +X1358(insert)X +X1561(a)X +X1622(datum)X +X1847(that)X +X2 f +X1992(cannot)X +X1 f +X2235(\(due)X +X2403(to)X +X2490(elaborate)X +X2810(worst-case)X +X3179(situations\))X +X3537(be)X +X3637(inserted.)X +X3935(\(It)X +X555 4028(will)N +X699(fail)X +X826(after)X +X994(a)X +X1050(pre-de\256ned)X +X1436(number)X +X1701(of)X +X1788(attempts.\))X +X3 f +X555 4220(Important)N +X931(Compatibility)X +X1426(Warning)X +X1 f +X755 4344(The)N +X2 f +X904(sdbm)X +X1 f +X1097(and)X +X2 f +X1237(ndbm)X +X1 f +X1439(libraries)X +X2 f +X1726(cannot)X +X1 f +X1968(share)X +X2162(databases:)X +X2515(one)X +X2654(cannot)X +X2891(read)X +X3053(the)X +X3174(\(dir/pag\))X +X3478(database)X +X3778(created)X +X555 4440(by)N +X657(the)X +X777(other.)X +X984(This)X +X1148(is)X +X1222(due)X +X1359(to)X +X1442(the)X +X1561(differences)X +X1940(between)X +X2229(the)X +X2 f +X2348(ndbm)X +X1 f +X2547(and)X +X2 f +X2684(sdbm)X +X1 f +X2874(algorithms)X +X8 s +X3216 4415(2)N +X10 s +X4440(,)Y +X3289(and)X +X3426(the)X +X3545(hash)X +X3713(functions)X +X555 4536(used.)N +X769(It)X +X845(is)X +X925(easy)X +X1094(to)X +X1182(convert)X +X1449(between)X +X1743(the)X +X2 f +X1867(dbm/ndbm)X +X1 f +X2231(databases)X +X2565(and)X +X2 f +X2707(sdbm)X +X1 f +X2902(by)X +X3008(ignoring)X +X3305(the)X +X3429(index)X +X3633(completely:)X +X555 4632(see)N +X7 f +X706(dbd)X +X1 f +X(,)S +X7 f +X918(dbu)X +X1 f +X1082(etc.)X +X3 f +X555 4852(Notice)N +X794(of)X +X881(Intellectual)X +X1288(Property)X +X2 f +X555 4976(The)N +X696(entire)X +X1 f +X904(sdbm)X +X2 f +X1118(library)X +X1361(package,)X +X1670(as)X +X1762(authored)X +X2072(by)X +X2169(me,)X +X1 f +X2304(Ozan)X +X2495(S.)X +X2580(Yigit,)X +X2 f +X2785(is)X +X2858(hereby)X +X3097(placed)X +X3331(in)X +X3413(the)X +X3531(public)X +X3751(domain.)X +X1 f +X555 5072(As)N +X670(such,)X +X863(the)X +X987(author)X +X1218(is)X +X1297(not)X +X1425(responsible)X +X1816(for)X +X1936(the)X +X2060(consequences)X +X2528(of)X +X2621(use)X +X2754(of)X +X2847(this)X +X2988(software,)X +X3310(no)X +X3415(matter)X +X3645(how)X +X3808(awful,)X +X555 5168(even)N +X727(if)X +X796(they)X +X954(arise)X +X1126(from)X +X1302(defects)X +X1550(in)X +X1632(it.)X +X1716(There)X +X1924(is)X +X1997(no)X +X2097(expressed)X +X2434(or)X +X2521(implied)X +X2785(warranty)X +X3091(for)X +X3205(the)X +X2 f +X3323(sdbm)X +X1 f +X3512(library.)X +X8 s +X10 f +X555 5316(hhhhhhhhhhhhhhhhhh)N +X6 s +X1 f +X635 5391(1)N +X8 s +X691 5410(UN*X)N +X877(is)X +X936(not)X +X1034(a)X +X1078(trademark)X +X1352(of)X +X1421(any)X +X1529(\(dis\)organization.)X +X6 s +X635 5485(2)N +X8 s +X691 5504(Torek's)N +X908(discussion)X +X1194([Tor87])X +X1411(indicates)X +X1657(that)X +X2 f +X1772(dbm/ndbm)X +X1 f +X2061(implementations)X +X2506(use)X +X2609(the)X +X2705(hash)X +X2840(value)X +X2996(to)X +X3064(traverse)X +X3283(the)X +X3379(radix)X +X3528(trie)X +X3631(dif-)X +X555 5584(ferently)N +X772(than)X +X2 f +X901(sdbm)X +X1 f +X1055(and)X +X1166(as)X +X1238(a)X +X1285(result,)X +X1462(the)X +X1559(page)X +X1698(indexes)X +X1912(are)X +X2008(generated)X +X2274(in)X +X2 f +X2343(different)X +X1 f +X2579(order.)X +X2764(For)X +X2872(more)X +X3021(information,)X +X3357(send)X +X3492(e-mail)X +X3673(to)X +X555 5664(the)N +X649(author.)X +X +X2 p +X%%Page: 2 2 +X8 s 0 xH 0 xS 1 f +X10 s +X2216 384(-)N +X2263(2)X +X2323(-)X +X755 672(Since)N +X971(the)X +X2 f +X1107(sdbm)X +X1 f +X1314(library)X +X1566(package)X +X1868(is)X +X1959(in)X +X2058(the)X +X2193(public)X +X2430(domain,)X +X2727(this)X +X2 f +X2879(original)X +X1 f +X3173(release)X +X3434(or)X +X3538(any)X +X3691(additional)X +X555 768(public-domain)N +X1045(releases)X +X1323(of)X +X1413(the)X +X1534(modi\256ed)X +X1841(original)X +X2112(cannot)X +X2348(possibly)X +X2636(\(by)X +X2765(de\256nition\))X +X3120(be)X +X3218(withheld)X +X3520(from)X +X3698(you.)X +X3860(Also)X +X555 864(by)N +X659(de\256nition,)X +X1009(You)X +X1170(\(singular\))X +X1505(have)X +X1680(all)X +X1783(the)X +X1904(rights)X +X2109(to)X +X2194(this)X +X2332(code)X +X2507(\(including)X +X2859(the)X +X2980(right)X +X3154(to)X +X3239(sell)X +X3373(without)X +X3640(permission,)X +X555 960(the)N +X679(right)X +X856(to)X +X944(hoard)X +X8 s +X1127 935(3)N +X10 s +X1185 960(and)N +X1327(the)X +X1451(right)X +X1628(to)X +X1716(do)X +X1821(other)X +X2011(icky)X +X2174(things)X +X2394(as)X +X2486(you)X +X2631(see)X +X2759(\256t\))X +X2877(but)X +X3004(those)X +X3198(rights)X +X3405(are)X +X3529(also)X +X3683(granted)X +X3949(to)X +X555 1056(everyone)N +X870(else.)X +X755 1180(Please)N +X997(note)X +X1172(that)X +X1329(all)X +X1446(previous)X +X1759(distributions)X +X2195(of)X +X2298(this)X +X2449(software)X +X2762(contained)X +X3110(a)X +X3182(copyright)X +X3525(\(which)X +X3784(is)X +X3873(now)X +X555 1276(dropped\))N +X868(to)X +X953(protect)X +X1199(its)X +X1297(origins)X +X1542(and)X +X1681(its)X +X1779(current)X +X2030(public)X +X2253(domain)X +X2516(status)X +X2721(against)X +X2970(any)X +X3108(possible)X +X3392(claims)X +X3623(and/or)X +X3850(chal-)X +X555 1372(lenges.)N +X3 f +X555 1564(Acknowledgments)N +X1 f +X755 1688(Many)N +X966(people)X +X1204(have)X +X1380(been)X +X1556(very)X +X1723(helpful)X +X1974(and)X +X2114(supportive.)X +X2515(A)X +X2596(partial)X +X2824(list)X +X2944(would)X +X3167(necessarily)X +X3547(include)X +X3806(Rayan)X +X555 1784(Zacherissen)N +X963(\(who)X +X1152(contributed)X +X1541(the)X +X1663(man)X +X1824(page,)X +X2019(and)X +X2158(also)X +X2310(hacked)X +X2561(a)X +X2620(MMAP)X +X2887(version)X +X3146(of)X +X2 f +X3236(sdbm)X +X1 f +X3405(\),)X +X3475(Arnold)X +X3725(Robbins,)X +X555 1880(Chris)N +X763(Lewis,)X +X1013(Bill)X +X1166(Davidsen,)X +X1523(Henry)X +X1758(Spencer,)X +X2071(Geoff)X +X2293(Collyer,)X +X2587(Rich)X +X2772(Salz)X +X2944(\(who)X +X3143(got)X +X3279(me)X +X3411(started)X +X3659(in)X +X3755(the)X +X3887(\256rst)X +X555 1976(place\),)N +X792(Johannes)X +X1106(Ruschein)X +X1424(\(who)X +X1609(did)X +X1731(the)X +X1849(minix)X +X2055(port\))X +X2231(and)X +X2367(David)X +X2583(Tilbrook.)X +X2903(I)X +X2950(thank)X +X3148(you)X +X3288(all.)X +X3 f +X555 2168(Distribution)N +X992(Manifest)X +X1315(and)X +X1463(Notes)X +X1 f +X555 2292(This)N +X717(distribution)X +X1105(of)X +X2 f +X1192(sdbm)X +X1 f +X1381(includes)X +X1668(\(at)X +X1773(least\))X +X1967(the)X +X2085(following:)X +X7 f +X747 2436(CHANGES)N +X1323(change)X +X1659(log)X +X747 2532(README)N +X1323(this)X +X1563(file.)X +X747 2628(biblio)N +X1323(a)X +X1419(small)X +X1707(bibliography)X +X2331(on)X +X2475(external)X +X2907(hashing)X +X747 2724(dba.c)N +X1323(a)X +X1419(crude)X +X1707(\(n/s\)dbm)X +X2139(page)X +X2379(file)X +X2619(analyzer)X +X747 2820(dbd.c)N +X1323(a)X +X1419(crude)X +X1707(\(n/s\)dbm)X +X2139(page)X +X2379(file)X +X2619(dumper)X +X2955(\(for)X +X3195(conversion\))X +X747 2916(dbe.1)N +X1323(man)X +X1515(page)X +X1755(for)X +X1947(dbe.c)X +X747 3012(dbe.c)N +X1323(Janick's)X +X1755(database)X +X2187(editor)X +X747 3108(dbm.c)N +X1323(a)X +X1419(dbm)X +X1611(library)X +X1995(emulation)X +X2475(wrapper)X +X2859(for)X +X3051(ndbm/sdbm)X +X747 3204(dbm.h)N +X1323(header)X +X1659(file)X +X1899(for)X +X2091(the)X +X2283(above)X +X747 3300(dbu.c)N +X1323(a)X +X1419(crude)X +X1707(db)X +X1851(management)X +X2379(utility)X +X747 3396(hash.c)N +X1323(hashing)X +X1707(function)X +X747 3492(makefile)N +X1323(guess.)X +X747 3588(pair.c)N +X1323(page-level)X +X1851(routines)X +X2283(\(posted)X +X2667(earlier\))X +X747 3684(pair.h)N +X1323(header)X +X1659(file)X +X1899(for)X +X2091(the)X +X2283(above)X +X747 3780(readme.ms)N +X1323(troff)X +X1611(source)X +X1947(for)X +X2139(the)X +X2331(README)X +X2667(file)X +X747 3876(sdbm.3)N +X1323(man)X +X1515(page)X +X747 3972(sdbm.c)N +X1323(the)X +X1515(real)X +X1755(thing)X +X747 4068(sdbm.h)N +X1323(header)X +X1659(file)X +X1899(for)X +X2091(the)X +X2283(above)X +X747 4164(tune.h)N +X1323(place)X +X1611(for)X +X1803(tuning)X +X2139(&)X +X2235(portability)X +X2811(thingies)X +X747 4260(util.c)N +X1323(miscellaneous)X +X755 4432(dbu)N +X1 f +X924(is)X +X1002(a)X +X1063(simple)X +X1301(database)X +X1603(manipulation)X +X2050(program)X +X8 s +X2322 4407(4)N +X10 s +X2379 4432(that)N +X2524(tries)X +X2687(to)X +X2774(look)X +X2941(like)X +X3086(Bell)X +X3244(Labs')X +X7 f +X3480(cbt)X +X1 f +X3649(utility.)X +X3884(It)X +X3958(is)X +X555 4528(currently)N +X867(incomplete)X +X1245(in)X +X1329(functionality.)X +X1800(I)X +X1849(use)X +X7 f +X2006(dbu)X +X1 f +X2172(to)X +X2255(test)X +X2387(out)X +X2510(the)X +X2629(routines:)X +X2930(it)X +X2995(takes)X +X3181(\(from)X +X3385(stdin\))X +X3588(tab)X +X3707(separated)X +X555 4624(key/value)N +X898(pairs)X +X1085(for)X +X1210(commands)X +X1587(like)X +X7 f +X1765(build)X +X1 f +X2035(or)X +X7 f +X2160(insert)X +X1 f +X2478(or)X +X2575(takes)X +X2770(keys)X +X2947(for)X +X3071(commands)X +X3448(like)X +X7 f +X3626(delete)X +X1 f +X3944(or)X +X7 f +X555 4720(look)N +X1 f +X(.)S +X7 f +X747 4864(dbu)N +X939(<build|creat|look|insert|cat|delete>)X +X2715(dbmfile)X +X755 5036(dba)N +X1 f +X927(is)X +X1008(a)X +X1072(crude)X +X1279(analyzer)X +X1580(of)X +X2 f +X1675(dbm/sdbm/ndbm)X +X1 f +X2232(page)X +X2412(\256les.)X +X2593(It)X +X2670(scans)X +X2872(the)X +X2998(entire)X +X3209(page)X +X3389(\256le,)X +X3538(reporting)X +X3859(page)X +X555 5132(level)N +X731(statistics,)X +X1046(and)X +X1182(totals)X +X1375(at)X +X1453(the)X +X1571(end.)X +X7 f +X755 5256(dbd)N +X1 f +X925(is)X +X1004(a)X +X1066(crude)X +X1271(dump)X +X1479(program)X +X1777(for)X +X2 f +X1897(dbm/ndbm/sdbm)X +X1 f +X2452(databases.)X +X2806(It)X +X2881(ignores)X +X3143(the)X +X3267(bitmap,)X +X3534(and)X +X3675(dumps)X +X3913(the)X +X555 5352(data)N +X717(pages)X +X928(in)X +X1018(sequence.)X +X1361(It)X +X1437(can)X +X1576(be)X +X1679(used)X +X1853(to)X +X1942(create)X +X2162(input)X +X2353(for)X +X2474(the)X +X7 f +X2627(dbu)X +X1 f +X2798(utility.)X +X3055(Note)X +X3238(that)X +X7 f +X3413(dbd)X +X1 f +X3584(will)X +X3735(skip)X +X3895(any)X +X8 s +X10 f +X555 5432(hhhhhhhhhhhhhhhhhh)N +X6 s +X1 f +X635 5507(3)N +X8 s +X691 5526(You)N +X817(cannot)X +X1003(really)X +X1164(hoard)X +X1325(something)X +X1608(that)X +X1720(is)X +X1779(available)X +X2025(to)X +X2091(the)X +X2185(public)X +X2361(at)X +X2423(large,)X +X2582(but)X +X2680(try)X +X2767(if)X +X2822(it)X +X2874(makes)X +X3053(you)X +X3165(feel)X +X3276(any)X +X3384(better.)X +X6 s +X635 5601(4)N +X8 s +X691 5620(The)N +X7 f +X829(dbd)X +X1 f +X943(,)X +X7 f +X998(dba)X +X1 f +X1112(,)X +X7 f +X1167(dbu)X +X1 f +X1298(utilities)X +X1508(are)X +X1602(quick)X +X1761(hacks)X +X1923(and)X +X2032(are)X +X2126(not)X +X2225(\256t)X +X2295(for)X +X2385(production)X +X2678(use.)X +X2795(They)X +X2942(were)X +X3081(developed)X +X3359(late)X +X3467(one)X +X3575(night,)X +X555 5700(just)N +X664(to)X +X730(test)X +X835(out)X +X2 f +X933(sdbm)X +X1 f +X1068(,)X +X1100(and)X +X1208(convert)X +X1415(some)X +X1566(databases.)X +X +X3 p +X%%Page: 3 3 +X8 s 0 xH 0 xS 1 f +X10 s +X2216 384(-)N +X2263(3)X +X2323(-)X +X555 672(NULLs)N +X821(in)X +X903(the)X +X1021(key)X +X1157(and)X +X1293(data)X +X1447(\256elds,)X +X1660(thus)X +X1813(is)X +X1886(unsuitable)X +X2235(to)X +X2317(convert)X +X2578(some)X +X2767(peculiar)X +X3046(databases)X +X3374(that)X +X3514(insist)X +X3702(in)X +X3784(includ-)X +X555 768(ing)N +X677(the)X +X795(terminating)X +X1184(null.)X +X755 892(I)N +X841(have)X +X1052(also)X +X1240(included)X +X1575(a)X +X1670(copy)X +X1885(of)X +X2011(the)X +X7 f +X2195(dbe)X +X1 f +X2397(\()X +X2 f +X2424(ndbm)X +X1 f +X2660(DataBase)X +X3026(Editor\))X +X3311(by)X +X3449(Janick)X +X3712(Bergeron)X +X555 988([janick@bnr.ca])N +X1098(for)X +X1212(your)X +X1379(pleasure.)X +X1687(You)X +X1845(may)X +X2003(\256nd)X +X2147(it)X +X2211(more)X +X2396(useful)X +X2612(than)X +X2770(the)X +X2888(little)X +X7 f +X3082(dbu)X +X1 f +X3246(utility.)X +X7 f +X755 1112(dbm.[ch])N +X1 f +X1169(is)X +X1252(a)X +X2 f +X1318(dbm)X +X1 f +X1486(library)X +X1730(emulation)X +X2079(on)X +X2188(top)X +X2319(of)X +X2 f +X2415(ndbm)X +X1 f +X2622(\(and)X +X2794(hence)X +X3011(suitable)X +X3289(for)X +X2 f +X3412(sdbm)X +X1 f +X3581(\).)X +X3657(Written)X +X3931(by)X +X555 1208(Robert)N +X793(Elz.)X +X755 1332(The)N +X2 f +X901(sdbm)X +X1 f +X1090(library)X +X1324(has)X +X1451(been)X +X1623(around)X +X1866(in)X +X1948(beta)X +X2102(test)X +X2233(for)X +X2347(quite)X +X2527(a)X +X2583(long)X +X2745(time,)X +X2927(and)X +X3063(from)X +X3239(whatever)X +X3554(little)X +X3720(feedback)X +X555 1428(I)N +X609(received)X +X909(\(maybe)X +X1177(no)X +X1284(news)X +X1476(is)X +X1555(good)X +X1741(news\),)X +X1979(I)X +X2032(believe)X +X2290(it)X +X2360(has)X +X2493(been)X +X2671(functioning)X +X3066(without)X +X3336(any)X +X3478(signi\256cant)X +X3837(prob-)X +X555 1524(lems.)N +X752(I)X +X805(would,)X +X1051(of)X +X1144(course,)X +X1400(appreciate)X +X1757(all)X +X1863(\256xes)X +X2040(and/or)X +X2271(improvements.)X +X2774(Portability)X +X3136(enhancements)X +X3616(would)X +X3841(espe-)X +X555 1620(cially)N +X753(be)X +X849(useful.)X +X3 f +X555 1812(Implementation)N +X1122(Issues)X +X1 f +X755 1936(Hash)N +X944(functions:)X +X1288(The)X +X1437(algorithm)X +X1772(behind)X +X2 f +X2014(sdbm)X +X1 f +X2207(implementation)X +X2733(needs)X +X2939(a)X +X2998(good)X +X3181(bit-scrambling)X +X3671(hash)X +X3841(func-)X +X555 2032(tion)N +X702(to)X +X787(be)X +X886(effective.)X +X1211(I)X +X1261(ran)X +X1387(into)X +X1534(a)X +X1593(set)X +X1705(of)X +X1795(constants)X +X2116(for)X +X2233(a)X +X2292(simple)X +X2528(hash)X +X2698(function)X +X2988(that)X +X3130(seem)X +X3317(to)X +X3401(help)X +X2 f +X3561(sdbm)X +X1 f +X3752(perform)X +X555 2128(better)N +X758(than)X +X2 f +X916(ndbm)X +X1 f +X1114(for)X +X1228(various)X +X1484(inputs:)X +X7 f +X747 2272(/*)N +X795 2368(*)N +X891(polynomial)X +X1419(conversion)X +X1947(ignoring)X +X2379(overflows)X +X795 2464(*)N +X891(65599)X +X1179(nice.)X +X1467(65587)X +X1755(even)X +X1995(better.)X +X795 2560(*/)N +X747 2656(long)N +X747 2752(dbm_hash\(char)N +X1419(*str,)X +X1707(int)X +X1899(len\))X +X2139({)X +X939 2848(register)N +X1371(unsigned)X +X1803(long)X +X2043(n)X +X2139(=)X +X2235(0;)X +X939 3040(while)N +X1227(\(len--\))X +X1131 3136(n)N +X1227(=)X +X1323(n)X +X1419(*)X +X1515(65599)X +X1803(+)X +X1899(*str++;)X +X939 3232(return)N +X1275(n;)X +X747 3328(})N +X1 f +X755 3500(There)N +X975(may)X +X1145(be)X +X1253(better)X +X1467(hash)X +X1645(functions)X +X1974(for)X +X2099(the)X +X2228(purposes)X +X2544(of)X +X2642(dynamic)X +X2949(hashing.)X +X3269(Try)X +X3416(your)X +X3594(favorite,)X +X3895(and)X +X555 3596(check)N +X766(the)X +X887(page\256le.)X +X1184(If)X +X1261(it)X +X1328(contains)X +X1618(too)X +X1743(many)X +X1944(pages)X +X2150(with)X +X2315(too)X +X2440(many)X +X2641(holes,)X +X2853(\(in)X +X2965(relation)X +X3233(to)X +X3318(this)X +X3456(one)X +X3595(for)X +X3712(example\))X +X555 3692(or)N +X656(if)X +X2 f +X739(sdbm)X +X1 f +X942(simply)X +X1193(stops)X +X1391(working)X +X1692(\(fails)X +X1891(after)X +X7 f +X2101(SPLTMAX)X +X1 f +X2471(attempts)X +X2776(to)X +X2872(split\))X +X3070(when)X +X3278(you)X +X3432(feed)X +X3604(your)X +X3784(NEWS)X +X7 f +X555 3788(history)N +X1 f +X912(\256le)X +X1035(to)X +X1118(it,)X +X1203(you)X +X1344(probably)X +X1650(do)X +X1751(not)X +X1874(have)X +X2047(a)X +X2104(good)X +X2285(hashing)X +X2555(function.)X +X2883(If)X +X2958(you)X +X3099(do)X +X3200(better)X +X3404(\(for)X +X3545(different)X +X3842(types)X +X555 3884(of)N +X642(input\),)X +X873(I)X +X920(would)X +X1140(like)X +X1280(to)X +X1362(know)X +X1560(about)X +X1758(the)X +X1876(function)X +X2163(you)X +X2303(use.)X +X755 4008(Block)N +X967(sizes:)X +X1166(It)X +X1236(seems)X +X1453(\(from)X +X1657(various)X +X1914(tests)X +X2077(on)X +X2178(a)X +X2235(few)X +X2377(machines\))X +X2727(that)X +X2867(a)X +X2923(page)X +X3095(\256le)X +X3217(block)X +X3415(size)X +X7 f +X3588(PBLKSIZ)X +X1 f +X3944(of)X +X555 4104(1024)N +X738(is)X +X814(by)X +X917(far)X +X1030(the)X +X1150(best)X +X1301(for)X +X1417(performance,)X +X1866(but)X +X1990(this)X +X2127(also)X +X2278(happens)X +X2563(to)X +X2647(limit)X +X2819(the)X +X2939(size)X +X3086(of)X +X3175(a)X +X3233(key/value)X +X3567(pair.)X +X3734(Depend-)X +X555 4200(ing)N +X681(on)X +X785(your)X +X956(needs,)X +X1183(you)X +X1327(may)X +X1489(wish)X +X1663(to)X +X1748(increase)X +X2035(the)X +X2156(page)X +X2331(size,)X +X2499(and)X +X2638(also)X +X2790(adjust)X +X7 f +X3032(PAIRMAX)X +X1 f +X3391(\(the)X +X3539(maximum)X +X3886(size)X +X555 4296(of)N +X648(a)X +X710(key/value)X +X1048(pair)X +X1199(allowed:)X +X1501(should)X +X1740(always)X +X1989(be)X +X2090(at)X +X2173(least)X +X2345(three)X +X2531(words)X +X2752(smaller)X +X3013(than)X +X7 f +X3204(PBLKSIZ)X +X1 f +X(.\))S +X3612(accordingly.)X +X555 4392(The)N +X706(system-wide)X +X1137(version)X +X1399(of)X +X1492(the)X +X1616(library)X +X1856(should)X +X2095(probably)X +X2406(be)X +X2508(con\256gured)X +X2877(with)X +X3044(1024)X +X3229(\(distribution)X +X3649(default\),)X +X3944(as)X +X555 4488(this)N +X690(appears)X +X956(to)X +X1038(be)X +X1134(suf\256cient)X +X1452(for)X +X1566(most)X +X1741(common)X +X2041(uses)X +X2199(of)X +X2 f +X2286(sdbm)X +X1 f +X2455(.)X +X3 f +X555 4680(Portability)N +X1 f +X755 4804(This)N +X917(package)X +X1201(has)X +X1328(been)X +X1500(tested)X +X1707(in)X +X1789(many)X +X1987(different)X +X2284(UN*Xes)X +X2585(even)X +X2757(including)X +X3079(minix,)X +X3305(and)X +X3441(appears)X +X3707(to)X +X3789(be)X +X3885(rea-)X +X555 4900(sonably)N +X824(portable.)X +X1127(This)X +X1289(does)X +X1456(not)X +X1578(mean)X +X1772(it)X +X1836(will)X +X1980(port)X +X2129(easily)X +X2336(to)X +X2418(non-UN*X)X +X2799(systems.)X +X3 f +X555 5092(Notes)N +X767(and)X +X915(Miscellaneous)X +X1 f +X755 5216(The)N +X2 f +X913(sdbm)X +X1 f +X1115(is)X +X1201(not)X +X1336(a)X +X1405(very)X +X1581(complicated)X +X2006(package,)X +X2323(at)X +X2414(least)X +X2594(not)X +X2729(after)X +X2910(you)X +X3063(familiarize)X +X3444(yourself)X +X3739(with)X +X3913(the)X +X555 5312(literature)N +X879(on)X +X993(external)X +X1286(hashing.)X +X1589(There)X +X1811(are)X +X1944(other)X +X2143(interesting)X +X2514(algorithms)X +X2889(in)X +X2984(existence)X +X3316(that)X +X3469(ensure)X +X3712(\(approxi-)X +X555 5408(mately\))N +X825(single-read)X +X1207(access)X +X1438(to)X +X1525(a)X +X1586(data)X +X1745(value)X +X1944(associated)X +X2299(with)X +X2466(any)X +X2607(key.)X +X2768(These)X +X2984(are)X +X3107(directory-less)X +X3568(schemes)X +X3864(such)X +X555 5504(as)N +X2 f +X644(linear)X +X857(hashing)X +X1 f +X1132([Lit80])X +X1381(\(+)X +X1475(Larson)X +X1720(variations\),)X +X2 f +X2105(spiral)X +X2313(storage)X +X1 f +X2575([Mar79])X +X2865(or)X +X2954(directory)X +X3265(schemes)X +X3558(such)X +X3726(as)X +X2 f +X3814(exten-)X +X555 5600(sible)N +X731(hashing)X +X1 f +X1009([Fag79])X +X1288(by)X +X1393(Fagin)X +X1600(et)X +X1683(al.)X +X1786(I)X +X1838(do)X +X1943(hope)X +X2124(these)X +X2314(sources)X +X2579(provide)X +X2848(a)X +X2908(reasonable)X +X3276(playground)X +X3665(for)X +X3783(experi-)X +X555 5696(mentation)N +X907(with)X +X1081(other)X +X1277(algorithms.)X +X1690(See)X +X1837(the)X +X1966(June)X +X2144(1988)X +X2335(issue)X +X2526(of)X +X2624(ACM)X +X2837(Computing)X +X3227(Surveys)X +X3516([Enb88])X +X3810(for)X +X3935(an)X +X555 5792(excellent)N +X865(overview)X +X1184(of)X +X1271(the)X +X1389(\256eld.)X +X +X4 p +X%%Page: 4 4 +X10 s 0 xH 0 xS 1 f +X2216 384(-)N +X2263(4)X +X2323(-)X +X3 f +X555 672(References)N +X1 f +X555 824([Lar78])N +X875(P.-A.)X +X1064(Larson,)X +X1327(``Dynamic)X +X1695(Hashing'',)X +X2 f +X2056(BIT)X +X1 f +X(,)S +X2216(vol.)X +X2378(18,)X +X2518(pp.)X +X2638(184-201,)X +X2945(1978.)X +X555 948([Tho90])N +X875(Ken)X +X1029(Thompson,)X +X2 f +X1411(private)X +X1658(communication)X +X1 f +X2152(,)X +X2192(Nov.)X +X2370(1990)X +X555 1072([Lit80])N +X875(W.)X +X992(Litwin,)X +X1246(``)X +X1321(Linear)X +X1552(Hashing:)X +X1862(A)X +X1941(new)X +X2096(tool)X +X2261(for)X +X2396(\256le)X +X2539(and)X +X2675(table)X +X2851(addressing'',)X +X2 f +X3288(Proceedings)X +X3709(of)X +X3791(the)X +X3909(6th)X +X875 1168(Conference)N +X1269(on)X +X1373(Very)X +X1548(Large)X +X1782(Dabatases)X +X2163(\(Montreal\))X +X1 f +X2515(,)X +X2558(pp.)X +X2701(212-223,)X +X3031(Very)X +X3215(Large)X +X3426(Database)X +X3744(Founda-)X +X875 1264(tion,)N +X1039(Saratoga,)X +X1360(Calif.,)X +X1580(1980.)X +X555 1388([Fag79])N +X875(R.)X +X969(Fagin,)X +X1192(J.)X +X1284(Nievergelt,)X +X1684(N.)X +X1803(Pippinger,)X +X2175(and)X +X2332(H.)X +X2451(R.)X +X2544(Strong,)X +X2797(``Extendible)X +X3218(Hashing)X +X3505(-)X +X3552(A)X +X3630(Fast)X +X3783(Access)X +X875 1484(Method)N +X1144(for)X +X1258(Dynamic)X +X1572(Files'',)X +X2 f +X1821(ACM)X +X2010(Trans.)X +X2236(Database)X +X2563(Syst.)X +X1 f +X2712(,)X +X2752(vol.)X +X2894(4,)X +X2994(no.3,)X +X3174(pp.)X +X3294(315-344,)X +X3601(Sept.)X +X3783(1979.)X +X555 1608([Wal84])N +X875(Rich)X +X1055(Wales,)X +X1305(``Discussion)X +X1739(of)X +X1835("dbm")X +X2072(data)X +X2235(base)X +X2406(system'',)X +X2 f +X2730(USENET)X +X3051(newsgroup)X +X3430(unix.wizards)X +X1 f +X3836(,)X +X3884(Jan.)X +X875 1704(1984.)N +X555 1828([Tor87])N +X875(Chris)X +X1068(Torek,)X +X1300(``Re:)X +X1505(dbm.a)X +X1743(and)X +X1899(ndbm.a)X +X2177(archives'',)X +X2 f +X2539(USENET)X +X2852(newsgroup)X +X3223(comp.unix)X +X1 f +X3555(,)X +X3595(1987.)X +X555 1952([Mar79])N +X875(G.)X +X974(N.)X +X1073(Martin,)X +X1332(``Spiral)X +X1598(Storage:)X +X1885(Incrementally)X +X2371(Augmentable)X +X2843(Hash)X +X3048(Addressed)X +X3427(Storage'',)X +X2 f +X3766(Techni-)X +X875 2048(cal)N +X993(Report)X +X1231(#27)X +X1 f +X(,)S +X1391(University)X +X1749(of)X +X1836(Varwick,)X +X2153(Coventry,)X +X2491(U.K.,)X +X2687(1979.)X +X555 2172([Enb88])N +X875(R.)X +X977(J.)X +X1057(Enbody)X +X1335(and)X +X1480(H.)X +X1586(C.)X +X1687(Du,)X +X1833(``Dynamic)X +X2209(Hashing)X +X2524(Schemes'',)X +X2 f +X2883(ACM)X +X3080(Computing)X +X3463(Surveys)X +X1 f +X3713(,)X +X3761(vol.)X +X3911(20,)X +X875 2268(no.)N +X995(2,)X +X1075(pp.)X +X1195(85-113,)X +X1462(June)X +X1629(1988.)X +X +X4 p +X%%Trailer +Xxt +X +Xxs +END_OF_FILE +if test 33302 -ne `wc -c <'readme.ps'`; then + echo shar: \"'readme.ps'\" unpacked with wrong size! +fi +# end of 'readme.ps' +fi +if test -f 'sdbm.3' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'sdbm.3'\" +else +echo shar: Extracting \"'sdbm.3'\" \(8952 characters\) +sed "s/^X//" >'sdbm.3' <<'END_OF_FILE' +X.\" $Id: sdbm.3,v 1.2 90/12/13 13:00:57 oz Exp $ +X.TH SDBM 3 "1 March 1990" +X.SH NAME +Xsdbm, dbm_open, dbm_prep, dbm_close, dbm_fetch, dbm_store, dbm_delete, dbm_firstkey, dbm_nextkey, dbm_hash, dbm_rdonly, dbm_error, dbm_clearerr, dbm_dirfno, dbm_pagfno \- data base subroutines +X.SH SYNOPSIS +X.nf +X.ft B +X#include <sdbm.h> +X.sp +Xtypedef struct { +X char *dptr; +X int dsize; +X} datum; +X.sp +Xdatum nullitem = { NULL, 0 }; +X.sp +X\s-1DBM\s0 *dbm_open(char *file, int flags, int mode) +X.sp +X\s-1DBM\s0 *dbm_prep(char *dirname, char *pagname, int flags, int mode) +X.sp +Xvoid dbm_close(\s-1DBM\s0 *db) +X.sp +Xdatum dbm_fetch(\s-1DBM\s0 *db, key) +X.sp +Xint dbm_store(\s-1DBM\s0 *db, datum key, datum val, int flags) +X.sp +Xint dbm_delete(\s-1DBM\s0 *db, datum key) +X.sp +Xdatum dbm_firstkey(\s-1DBM\s0 *db) +X.sp +Xdatum dbm_nextkey(\s-1DBM\s0 *db) +X.sp +Xlong dbm_hash(char *string, int len) +X.sp +Xint dbm_rdonly(\s-1DBM\s0 *db) +Xint dbm_error(\s-1DBM\s0 *db) +Xdbm_clearerr(\s-1DBM\s0 *db) +Xint dbm_dirfno(\s-1DBM\s0 *db) +Xint dbm_pagfno(\s-1DBM\s0 *db) +X.ft R +X.fi +X.SH DESCRIPTION +X.IX "database library" sdbm "" "\fLsdbm\fR" +X.IX dbm_open "" "\fLdbm_open\fR \(em open \fLsdbm\fR database" +X.IX dbm_prep "" "\fLdbm_prep\fR \(em prepare \fLsdbm\fR database" +X.IX dbm_close "" "\fLdbm_close\fR \(em close \fLsdbm\fR routine" +X.IX dbm_fetch "" "\fLdbm_fetch\fR \(em fetch \fLsdbm\fR database data" +X.IX dbm_store "" "\fLdbm_store\fR \(em add data to \fLsdbm\fR database" +X.IX dbm_delete "" "\fLdbm_delete\fR \(em remove data from \fLsdbm\fR database" +X.IX dbm_firstkey "" "\fLdbm_firstkey\fR \(em access \fLsdbm\fR database" +X.IX dbm_nextkey "" "\fLdbm_nextkey\fR \(em access \fLsdbm\fR database" +X.IX dbm_hash "" "\fLdbm_hash\fR \(em string hash for \fLsdbm\fR database" +X.IX dbm_rdonly "" "\fLdbm_rdonly\fR \(em return \fLsdbm\fR database read-only mode" +X.IX dbm_error "" "\fLdbm_error\fR \(em return \fLsdbm\fR database error condition" +X.IX dbm_clearerr "" "\fLdbm_clearerr\fR \(em clear \fLsdbm\fR database error condition" +X.IX dbm_dirfno "" "\fLdbm_dirfno\fR \(em return \fLsdbm\fR database bitmap file descriptor" +X.IX dbm_pagfno "" "\fLdbm_pagfno\fR \(em return \fLsdbm\fR database data file descriptor" +X.IX "database functions \(em \fLsdbm\fR" dbm_open "" \fLdbm_open\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_prep "" \fLdbm_prep\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_close "" \fLdbm_close\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_fetch "" \fLdbm_fetch\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_store "" \fLdbm_store\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_delete "" \fLdbm_delete\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_firstkey "" \fLdbm_firstkey\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_nextkey "" \fLdbm_nextkey\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_rdonly "" \fLdbm_rdonly\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_error "" \fLdbm_error\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_clearerr "" \fLdbm_clearerr\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_dirfno "" \fLdbm_dirfno\fP +X.IX "database functions \(em \fLsdbm\fR" dbm_pagfno "" \fLdbm_pagfno\fP +X.LP +XThis package allows an application to maintain a mapping of <key,value> pairs +Xin disk files. This is not to be considered a real database system, but is +Xstill useful in many simple applications built around fast retrieval of a data +Xvalue from a key. This implementation uses an external hashing scheme, +Xcalled Dynamic Hashing, as described by Per-Aake Larson in BIT 18 (1978) pp. +X184-201. Retrieval of any item usually requires a single disk access. +XThe application interface is compatible with the +X.IR ndbm (3) +Xlibrary. +X.LP +XAn +X.B sdbm +Xdatabase is kept in two files usually given the extensions +X.B \.dir +Xand +X.BR \.pag . +XThe +X.B \.dir +Xfile contains a bitmap representing a forest of binary hash trees, the leaves +Xof which indicate data pages in the +X.B \.pag +Xfile. +X.LP +XThe application interface uses the +X.B datum +Xstructure to describe both +X.I keys +Xand +X.IR value s. +XA +X.B datum +Xspecifies a byte sequence of +X.I dsize +Xsize pointed to by +X.IR dptr . +XIf you use +X.SM ASCII +Xstrings as +X.IR key s +Xor +X.IR value s, +Xthen you must decide whether or not to include the terminating +X.SM NUL +Xbyte which sometimes defines strings. Including it will require larger +Xdatabase files, but it will be possible to get sensible output from a +X.IR strings (1) +Xcommand applied to the data file. +X.LP +XIn order to allow a process using this package to manipulate multiple +Xdatabases, the applications interface always requires a +X.IR handle , +Xa +X.BR "DBM *" , +Xto identify the database to be manipulated. Such a handle can be obtained +Xfrom the only routines that do not require it, namely +X.BR dbm_open (\|) +Xor +X.BR dbm_prep (\|). +XEither of these will open or create the two necessary files. The +Xdifference is that the latter allows explicitly naming the bitmap and data +Xfiles whereas +X.BR dbm_open (\|) +Xwill take a base file name and call +X.BR dbm_prep (\|) +Xwith the default extensions. +XThe +X.I flags +Xand +X.I mode +Xparameters are the same as for +X.BR open (2). +X.LP +XTo free the resources occupied while a database handle is active, call +X.BR dbm_close (\|). +X.LP +XGiven a handle, one can retrieve data associated with a key by using the +X.BR dbm_fetch (\|) +Xroutine, and associate data with a key by using the +X.BR dbm_store (\|) +Xroutine. +X.LP +XThe values of the +X.I flags +Xparameter for +X.BR dbm_store (\|) +Xcan be either +X.BR \s-1DBM_INSERT\s0 , +Xwhich will not change an existing entry with the same key, or +X.BR \s-1DBM_REPLACE\s0 , +Xwhich will replace an existing entry with the same key. +XKeys are unique within the database. +X.LP +XTo delete a key and its associated value use the +X.BR dbm_delete (\|) +Xroutine. +X.LP +XTo retrieve every key in the database, use a loop like: +X.sp +X.nf +X.ft B +Xfor (key = dbm_firstkey(db); key.dptr != NULL; key = dbm_nextkey(db)) +X ; +X.ft R +X.fi +X.LP +XThe order of retrieval is unspecified. +X.LP +XIf you determine that the performance of the database is inadequate or +Xyou notice clustering or other effects that may be due to the hashing +Xalgorithm used by this package, you can override it by supplying your +Xown +X.BR dbm_hash (\|) +Xroutine. Doing so will make the database unintelligable to any other +Xapplications that do not use your specialized hash function. +X.sp +X.LP +XThe following macros are defined in the header file: +X.IP +X.BR dbm_rdonly (\|) +Xreturns true if the database has been opened read\-only. +X.IP +X.BR dbm_error (\|) +Xreturns true if an I/O error has occurred. +X.IP +X.BR dbm_clearerr (\|) +Xallows you to clear the error flag if you think you know what the error +Xwas and insist on ignoring it. +X.IP +X.BR dbm_dirfno (\|) +Xreturns the file descriptor associated with the bitmap file. +X.IP +X.BR dbm_pagfno (\|) +Xreturns the file descriptor associated with the data file. +X.SH SEE ALSO +X.IR open (2). +X.SH DIAGNOSTICS +XFunctions that return a +X.B "DBM *" +Xhandle will use +X.SM NULL +Xto indicate an error. +XFunctions that return an +X.B int +Xwill use \-1 to indicate an error. The normal return value in that case is 0. +XFunctions that return a +X.B datum +Xwill return +X.B nullitem +Xto indicate an error. +X.LP +XAs a special case of +X.BR dbm_store (\|), +Xif it is called with the +X.B \s-1DBM_INSERT\s0 +Xflag and the key already exists in the database, the return value will be 1. +X.LP +XIn general, if a function parameter is invalid, +X.B errno +Xwill be set to +X.BR \s-1EINVAL\s0 . +XIf a write operation is requested on a read-only database, +X.B errno +Xwill be set to +X.BR \s-1ENOPERM\s0 . +XIf a memory allocation (using +X.IR malloc (3)) +Xfailed, +X.B errno +Xwill be set to +X.BR \s-1ENOMEM\s0 . +XFor I/O operation failures +X.B errno +Xwill contain the value set by the relevant failed system call, either +X.IR read (2), +X.IR write (2), +Xor +X.IR lseek (2). +X.SH AUTHOR +X.IP "Ozan S. Yigit" (oz@nexus.yorku.ca) +X.SH BUGS +XThe sum of key and value data sizes must not exceed +X.B \s-1PAIRMAX\s0 +X(1008 bytes). +X.LP +XThe sum of the key and value data sizes where several keys hash to the +Xsame value must fit within one bitmap page. +X.LP +XThe +X.B \.pag +Xfile will contain holes, so its apparent size is larger than its contents. +XWhen copied through the filesystem the holes will be filled. +X.LP +XThe contents of +X.B datum +Xvalues returned are in volatile storage. If you want to retain the values +Xpointed to, you must copy them immediately before another call to this package. +X.LP +XThe only safe way for multiple processes to (read and) update a database at +Xthe same time, is to implement a private locking scheme outside this package +Xand open and close the database between lock acquisitions. It is safe for +Xmultiple processes to concurrently access a database read-only. +X.SH APPLICATIONS PORTABILITY +XFor complete source code compatibility with the Berkeley Unix +X.IR ndbm (3) +Xlibrary, the +X.B sdbm.h +Xheader file should be installed in +X.BR /usr/include/ndbm.h . +X.LP +XThe +X.B nullitem +Xdata item, and the +X.BR dbm_prep (\|), +X.BR dbm_hash (\|), +X.BR dbm_rdonly (\|), +X.BR dbm_dirfno (\|), +Xand +X.BR dbm_pagfno (\|) +Xfunctions are unique to this package. +END_OF_FILE +if test 8952 -ne `wc -c <'sdbm.3'`; then + echo shar: \"'sdbm.3'\" unpacked with wrong size! +fi +# end of 'sdbm.3' +fi +if test -f 'sdbm.c' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'sdbm.c'\" +else +echo shar: Extracting \"'sdbm.c'\" \(11029 characters\) +sed "s/^X//" >'sdbm.c' <<'END_OF_FILE' +X/* +X * sdbm - ndbm work-alike hashed database library +X * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). +X * author: oz@nexus.yorku.ca +X * status: public domain. +X * +X * core routines +X */ +X +X#ifndef lint +Xstatic char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $"; +X#endif +X +X#include "sdbm.h" +X#include "tune.h" +X#include "pair.h" +X +X#include <sys/types.h> +X#include <sys/stat.h> +X#ifdef BSD42 +X#include <sys/file.h> +X#else +X#include <fcntl.h> +X#include <memory.h> +X#endif +X#include <errno.h> +X#include <string.h> +X +X#ifdef __STDC__ +X#include <stddef.h> +X#endif +X +X#ifndef NULL +X#define NULL 0 +X#endif +X +X/* +X * externals +X */ +X#ifndef sun +Xextern int errno; +X#endif +X +Xextern char *malloc proto((unsigned int)); +Xextern void free proto((void *)); +Xextern long lseek(); +X +X/* +X * forward +X */ +Xstatic int getdbit proto((DBM *, long)); +Xstatic int setdbit proto((DBM *, long)); +Xstatic int getpage proto((DBM *, long)); +Xstatic datum getnext proto((DBM *)); +Xstatic int makroom proto((DBM *, long, int)); +X +X/* +X * useful macros +X */ +X#define bad(x) ((x).dptr == NULL || (x).dsize <= 0) +X#define exhash(item) dbm_hash((item).dptr, (item).dsize) +X#define ioerr(db) ((db)->flags |= DBM_IOERR) +X +X#define OFF_PAG(off) (long) (off) * PBLKSIZ +X#define OFF_DIR(off) (long) (off) * DBLKSIZ +X +Xstatic long masks[] = { +X 000000000000, 000000000001, 000000000003, 000000000007, +X 000000000017, 000000000037, 000000000077, 000000000177, +X 000000000377, 000000000777, 000000001777, 000000003777, +X 000000007777, 000000017777, 000000037777, 000000077777, +X 000000177777, 000000377777, 000000777777, 000001777777, +X 000003777777, 000007777777, 000017777777, 000037777777, +X 000077777777, 000177777777, 000377777777, 000777777777, +X 001777777777, 003777777777, 007777777777, 017777777777 +X}; +X +Xdatum nullitem = {NULL, 0}; +X +XDBM * +Xdbm_open(file, flags, mode) +Xregister char *file; +Xregister int flags; +Xregister int mode; +X{ +X register DBM *db; +X register char *dirname; +X register char *pagname; +X register int n; +X +X if (file == NULL || !*file) +X return errno = EINVAL, (DBM *) NULL; +X/* +X * need space for two seperate filenames +X */ +X n = strlen(file) * 2 + strlen(DIRFEXT) + strlen(PAGFEXT) + 2; +X +X if ((dirname = malloc((unsigned) n)) == NULL) +X return errno = ENOMEM, (DBM *) NULL; +X/* +X * build the file names +X */ +X dirname = strcat(strcpy(dirname, file), DIRFEXT); +X pagname = strcpy(dirname + strlen(dirname) + 1, file); +X pagname = strcat(pagname, PAGFEXT); +X +X db = dbm_prep(dirname, pagname, flags, mode); +X free((char *) dirname); +X return db; +X} +X +XDBM * +Xdbm_prep(dirname, pagname, flags, mode) +Xchar *dirname; +Xchar *pagname; +Xint flags; +Xint mode; +X{ +X register DBM *db; +X struct stat dstat; +X +X if ((db = (DBM *) malloc(sizeof(DBM))) == NULL) +X return errno = ENOMEM, (DBM *) NULL; +X +X db->flags = 0; +X db->hmask = 0; +X db->blkptr = 0; +X db->keyptr = 0; +X/* +X * adjust user flags so that WRONLY becomes RDWR, +X * as required by this package. Also set our internal +X * flag for RDONLY if needed. +X */ +X if (flags & O_WRONLY) +X flags = (flags & ~O_WRONLY) | O_RDWR; +X +X else if ((flags & 03) == O_RDONLY) +X db->flags = DBM_RDONLY; +X/* +X * open the files in sequence, and stat the dirfile. +X * If we fail anywhere, undo everything, return NULL. +X */ +X if ((db->pagf = open(pagname, flags, mode)) > -1) { +X if ((db->dirf = open(dirname, flags, mode)) > -1) { +X/* +X * need the dirfile size to establish max bit number. +X */ +X if (fstat(db->dirf, &dstat) == 0) { +X/* +X * zero size: either a fresh database, or one with a single, +X * unsplit data page: dirpage is all zeros. +X */ +X db->dirbno = (!dstat.st_size) ? 0 : -1; +X db->pagbno = -1; +X db->maxbno = dstat.st_size * BYTESIZ; +X +X (void) memset(db->pagbuf, 0, PBLKSIZ); +X (void) memset(db->dirbuf, 0, DBLKSIZ); +X /* +X * success +X */ +X return db; +X } +X (void) close(db->dirf); +X } +X (void) close(db->pagf); +X } +X free((char *) db); +X return (DBM *) NULL; +X} +X +Xvoid +Xdbm_close(db) +Xregister DBM *db; +X{ +X if (db == NULL) +X errno = EINVAL; +X else { +X (void) close(db->dirf); +X (void) close(db->pagf); +X free((char *) db); +X } +X} +X +Xdatum +Xdbm_fetch(db, key) +Xregister DBM *db; +Xdatum key; +X{ +X if (db == NULL || bad(key)) +X return errno = EINVAL, nullitem; +X +X if (getpage(db, exhash(key))) +X return getpair(db->pagbuf, key); +X +X return ioerr(db), nullitem; +X} +X +Xint +Xdbm_delete(db, key) +Xregister DBM *db; +Xdatum key; +X{ +X if (db == NULL || bad(key)) +X return errno = EINVAL, -1; +X if (dbm_rdonly(db)) +X return errno = EPERM, -1; +X +X if (getpage(db, exhash(key))) { +X if (!delpair(db->pagbuf, key)) +X return -1; +X/* +X * update the page file +X */ +X if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 +X || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) +X return ioerr(db), -1; +X +X return 0; +X } +X +X return ioerr(db), -1; +X} +X +Xint +Xdbm_store(db, key, val, flags) +Xregister DBM *db; +Xdatum key; +Xdatum val; +Xint flags; +X{ +X int need; +X register long hash; +X +X if (db == NULL || bad(key)) +X return errno = EINVAL, -1; +X if (dbm_rdonly(db)) +X return errno = EPERM, -1; +X +X need = key.dsize + val.dsize; +X/* +X * is the pair too big (or too small) for this database ?? +X */ +X if (need < 0 || need > PAIRMAX) +X return errno = EINVAL, -1; +X +X if (getpage(db, (hash = exhash(key)))) { +X/* +X * if we need to replace, delete the key/data pair +X * first. If it is not there, ignore. +X */ +X if (flags == DBM_REPLACE) +X (void) delpair(db->pagbuf, key); +X#ifdef SEEDUPS +X else if (duppair(db->pagbuf, key)) +X return 1; +X#endif +X/* +X * if we do not have enough room, we have to split. +X */ +X if (!fitpair(db->pagbuf, need)) +X if (!makroom(db, hash, need)) +X return ioerr(db), -1; +X/* +X * we have enough room or split is successful. insert the key, +X * and update the page file. +X */ +X (void) putpair(db->pagbuf, key, val); +X +X if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 +X || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) +X return ioerr(db), -1; +X /* +X * success +X */ +X return 0; +X } +X +X return ioerr(db), -1; +X} +X +X/* +X * makroom - make room by splitting the overfull page +X * this routine will attempt to make room for SPLTMAX times before +X * giving up. +X */ +Xstatic int +Xmakroom(db, hash, need) +Xregister DBM *db; +Xlong hash; +Xint need; +X{ +X long newp; +X char twin[PBLKSIZ]; +X char *pag = db->pagbuf; +X char *new = twin; +X register int smax = SPLTMAX; +X +X do { +X/* +X * split the current page +X */ +X (void) splpage(pag, new, db->hmask + 1); +X/* +X * address of the new page +X */ +X newp = (hash & db->hmask) | (db->hmask + 1); +X +X/* +X * write delay, read avoidence/cache shuffle: +X * select the page for incoming pair: if key is to go to the new page, +X * write out the previous one, and copy the new one over, thus making +X * it the current page. If not, simply write the new page, and we are +X * still looking at the page of interest. current page is not updated +X * here, as dbm_store will do so, after it inserts the incoming pair. +X */ +X if (hash & (db->hmask + 1)) { +X if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 +X || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) +X return 0; +X db->pagbno = newp; +X (void) memcpy(pag, new, PBLKSIZ); +X } +X else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0 +X || write(db->pagf, new, PBLKSIZ) < 0) +X return 0; +X +X if (!setdbit(db, db->curbit)) +X return 0; +X/* +X * see if we have enough room now +X */ +X if (fitpair(pag, need)) +X return 1; +X/* +X * try again... update curbit and hmask as getpage would have +X * done. because of our update of the current page, we do not +X * need to read in anything. BUT we have to write the current +X * [deferred] page out, as the window of failure is too great. +X */ +X db->curbit = 2 * db->curbit + +X ((hash & (db->hmask + 1)) ? 2 : 1); +X db->hmask |= db->hmask + 1; +X +X if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 +X || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) +X return 0; +X +X } while (--smax); +X/* +X * if we are here, this is real bad news. After SPLTMAX splits, +X * we still cannot fit the key. say goodnight. +X */ +X#ifdef BADMESS +X (void) write(2, "sdbm: cannot insert after SPLTMAX attempts.\n", 44); +X#endif +X return 0; +X +X} +X +X/* +X * the following two routines will break if +X * deletions aren't taken into account. (ndbm bug) +X */ +Xdatum +Xdbm_firstkey(db) +Xregister DBM *db; +X{ +X if (db == NULL) +X return errno = EINVAL, nullitem; +X/* +X * start at page 0 +X */ +X if (lseek(db->pagf, OFF_PAG(0), SEEK_SET) < 0 +X || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) +X return ioerr(db), nullitem; +X db->pagbno = 0; +X db->blkptr = 0; +X db->keyptr = 0; +X +X return getnext(db); +X} +X +Xdatum +Xdbm_nextkey(db) +Xregister DBM *db; +X{ +X if (db == NULL) +X return errno = EINVAL, nullitem; +X return getnext(db); +X} +X +X/* +X * all important binary trie traversal +X */ +Xstatic int +Xgetpage(db, hash) +Xregister DBM *db; +Xregister long hash; +X{ +X register int hbit; +X register long dbit; +X register long pagb; +X +X dbit = 0; +X hbit = 0; +X while (dbit < db->maxbno && getdbit(db, dbit)) +X dbit = 2 * dbit + ((hash & (1 << hbit++)) ? 2 : 1); +X +X debug(("dbit: %d...", dbit)); +X +X db->curbit = dbit; +X db->hmask = masks[hbit]; +X +X pagb = hash & db->hmask; +X/* +X * see if the block we need is already in memory. +X * note: this lookaside cache has about 10% hit rate. +X */ +X if (pagb != db->pagbno) { +X/* +X * note: here, we assume a "hole" is read as 0s. +X * if not, must zero pagbuf first. +X */ +X if (lseek(db->pagf, OFF_PAG(pagb), SEEK_SET) < 0 +X || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) +X return 0; +X if (!chkpage(db->pagbuf)) +X return 0; +X db->pagbno = pagb; +X +X debug(("pag read: %d\n", pagb)); +X } +X return 1; +X} +X +Xstatic int +Xgetdbit(db, dbit) +Xregister DBM *db; +Xregister long dbit; +X{ +X register long c; +X register long dirb; +X +X c = dbit / BYTESIZ; +X dirb = c / DBLKSIZ; +X +X if (dirb != db->dirbno) { +X if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 +X || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) +X return 0; +X db->dirbno = dirb; +X +X debug(("dir read: %d\n", dirb)); +X } +X +X return db->dirbuf[c % DBLKSIZ] & (1 << dbit % BYTESIZ); +X} +X +Xstatic int +Xsetdbit(db, dbit) +Xregister DBM *db; +Xregister long dbit; +X{ +X register long c; +X register long dirb; +X +X c = dbit / BYTESIZ; +X dirb = c / DBLKSIZ; +X +X if (dirb != db->dirbno) { +X if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 +X || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) +X return 0; +X db->dirbno = dirb; +X +X debug(("dir read: %d\n", dirb)); +X } +X +X db->dirbuf[c % DBLKSIZ] |= (1 << dbit % BYTESIZ); +X +X if (dbit >= db->maxbno) +X db->maxbno += DBLKSIZ * BYTESIZ; +X +X if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 +X || write(db->dirf, db->dirbuf, DBLKSIZ) < 0) +X return 0; +X +X return 1; +X} +X +X/* +X * getnext - get the next key in the page, and if done with +X * the page, try the next page in sequence +X */ +Xstatic datum +Xgetnext(db) +Xregister DBM *db; +X{ +X datum key; +X +X for (;;) { +X db->keyptr++; +X key = getnkey(db->pagbuf, db->keyptr); +X if (key.dptr != NULL) +X return key; +X/* +X * we either run out, or there is nothing on this page.. +X * try the next one... If we lost our position on the +X * file, we will have to seek. +X */ +X db->keyptr = 0; +X if (db->pagbno != db->blkptr++) +X if (lseek(db->pagf, OFF_PAG(db->blkptr), SEEK_SET) < 0) +X break; +X db->pagbno = db->blkptr; +X if (read(db->pagf, db->pagbuf, PBLKSIZ) <= 0) +X break; +X if (!chkpage(db->pagbuf)) +X break; +X } +X +X return ioerr(db), nullitem; +X} +END_OF_FILE +if test 11029 -ne `wc -c <'sdbm.c'`; then + echo shar: \"'sdbm.c'\" unpacked with wrong size! +fi +# end of 'sdbm.c' +fi +if test -f 'sdbm.h' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'sdbm.h'\" +else +echo shar: Extracting \"'sdbm.h'\" \(2174 characters\) +sed "s/^X//" >'sdbm.h' <<'END_OF_FILE' +X/* +X * sdbm - ndbm work-alike hashed database library +X * based on Per-Ake Larson's Dynamic Hashing algorithms. BIT 18 (1978). +X * author: oz@nexus.yorku.ca +X * status: public domain. +X */ +X#define DBLKSIZ 4096 +X#define PBLKSIZ 1024 +X#define PAIRMAX 1008 /* arbitrary on PBLKSIZ-N */ +X#define SPLTMAX 10 /* maximum allowed splits */ +X /* for a single insertion */ +X#define DIRFEXT ".dir" +X#define PAGFEXT ".pag" +X +Xtypedef struct { +X int dirf; /* directory file descriptor */ +X int pagf; /* page file descriptor */ +X int flags; /* status/error flags, see below */ +X long maxbno; /* size of dirfile in bits */ +X long curbit; /* current bit number */ +X long hmask; /* current hash mask */ +X long blkptr; /* current block for nextkey */ +X int keyptr; /* current key for nextkey */ +X long blkno; /* current page to read/write */ +X long pagbno; /* current page in pagbuf */ +X char pagbuf[PBLKSIZ]; /* page file block buffer */ +X long dirbno; /* current block in dirbuf */ +X char dirbuf[DBLKSIZ]; /* directory file block buffer */ +X} DBM; +X +X#define DBM_RDONLY 0x1 /* data base open read-only */ +X#define DBM_IOERR 0x2 /* data base I/O error */ +X +X/* +X * utility macros +X */ +X#define dbm_rdonly(db) ((db)->flags & DBM_RDONLY) +X#define dbm_error(db) ((db)->flags & DBM_IOERR) +X +X#define dbm_clearerr(db) ((db)->flags &= ~DBM_IOERR) /* ouch */ +X +X#define dbm_dirfno(db) ((db)->dirf) +X#define dbm_pagfno(db) ((db)->pagf) +X +Xtypedef struct { +X char *dptr; +X int dsize; +X} datum; +X +Xextern datum nullitem; +X +X#ifdef __STDC__ +X#define proto(p) p +X#else +X#define proto(p) () +X#endif +X +X/* +X * flags to dbm_store +X */ +X#define DBM_INSERT 0 +X#define DBM_REPLACE 1 +X +X/* +X * ndbm interface +X */ +Xextern DBM *dbm_open proto((char *, int, int)); +Xextern void dbm_close proto((DBM *)); +Xextern datum dbm_fetch proto((DBM *, datum)); +Xextern int dbm_delete proto((DBM *, datum)); +Xextern int dbm_store proto((DBM *, datum, datum, int)); +Xextern datum dbm_firstkey proto((DBM *)); +Xextern datum dbm_nextkey proto((DBM *)); +X +X/* +X * other +X */ +Xextern DBM *dbm_prep proto((char *, char *, int, int)); +Xextern long dbm_hash proto((char *, int)); +END_OF_FILE +if test 2174 -ne `wc -c <'sdbm.h'`; then + echo shar: \"'sdbm.h'\" unpacked with wrong size! +fi +# end of 'sdbm.h' +fi +if test -f 'tune.h' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'tune.h'\" +else +echo shar: Extracting \"'tune.h'\" \(665 characters\) +sed "s/^X//" >'tune.h' <<'END_OF_FILE' +X/* +X * sdbm - ndbm work-alike hashed database library +X * tuning and portability constructs [not nearly enough] +X * author: oz@nexus.yorku.ca +X */ +X +X#define BYTESIZ 8 +X +X#ifdef SVID +X#include <unistd.h> +X#endif +X +X#ifdef BSD42 +X#define SEEK_SET L_SET +X#define memset(s,c,n) bzero(s, n) /* only when c is zero */ +X#define memcpy(s1,s2,n) bcopy(s2, s1, n) +X#define memcmp(s1,s2,n) bcmp(s1,s2,n) +X#endif +X +X/* +X * important tuning parms (hah) +X */ +X +X#define SEEDUPS /* always detect duplicates */ +X#define BADMESS /* generate a message for worst case: +X cannot make room after SPLTMAX splits */ +X/* +X * misc +X */ +X#ifdef DEBUG +X#define debug(x) printf x +X#else +X#define debug(x) +X#endif +END_OF_FILE +if test 665 -ne `wc -c <'tune.h'`; then + echo shar: \"'tune.h'\" unpacked with wrong size! +fi +# end of 'tune.h' +fi +if test -f 'util.c' -a "${1}" != "-c" ; then + echo shar: Will not clobber existing file \"'util.c'\" +else +echo shar: Extracting \"'util.c'\" \(767 characters\) +sed "s/^X//" >'util.c' <<'END_OF_FILE' +X#include <stdio.h> +X#ifdef SDBM +X#include "sdbm.h" +X#else +X#include "ndbm.h" +X#endif +X +Xvoid +Xoops(s1, s2) +Xregister char *s1; +Xregister char *s2; +X{ +X extern int errno, sys_nerr; +X extern char *sys_errlist[]; +X extern char *progname; +X +X if (progname) +X fprintf(stderr, "%s: ", progname); +X fprintf(stderr, s1, s2); +X if (errno > 0 && errno < sys_nerr) +X fprintf(stderr, " (%s)", sys_errlist[errno]); +X fprintf(stderr, "\n"); +X exit(1); +X} +X +Xint +Xokpage(pag) +Xchar *pag; +X{ +X register unsigned n; +X register off; +X register short *ino = (short *) pag; +X +X if ((n = ino[0]) > PBLKSIZ / sizeof(short)) +X return 0; +X +X if (!n) +X return 1; +X +X off = PBLKSIZ; +X for (ino++; n; ino += 2) { +X if (ino[0] > off || ino[1] > off || +X ino[1] > ino[0]) +X return 0; +X off = ino[1]; +X n -= 2; +X } +X +X return 1; +X} +END_OF_FILE +if test 767 -ne `wc -c <'util.c'`; then + echo shar: \"'util.c'\" unpacked with wrong size! +fi +# end of 'util.c' +fi +echo shar: End of shell archive. +exit 0 diff --git a/ext/dbm/sdbm/CHANGES b/ext/dbm/sdbm/CHANGES new file mode 100644 index 0000000000..f7296d1b3a --- /dev/null +++ b/ext/dbm/sdbm/CHANGES @@ -0,0 +1,18 @@ +Changes from the earlier BETA releases. + +o dbm_prep does everything now, so dbm_open is just a simple + wrapper that builds the default filenames. dbm_prep no longer + requires a (DBM *) db parameter: it allocates one itself. It + returns (DBM *) db or (DBM *) NULL. + +o makroom is now reliable. In the common-case optimization of the page + split, the page into which the incoming key/value pair is to be inserted + is write-deferred (if the split is successful), thereby saving a cosly + write. BUT, if the split does not make enough room (unsuccessful), the + deferred page is written out, as the failure-window is now dependent on + the number of split attempts. + +o if -DDUFF is defined, hash function will also use the DUFF construct. + This may look like a micro-performance tweak (maybe it is), but in fact, + the hash function is the third most-heavily used function, after read + and write. diff --git a/ext/dbm/sdbm/COMPARE b/ext/dbm/sdbm/COMPARE new file mode 100644 index 0000000000..a595e831d2 --- /dev/null +++ b/ext/dbm/sdbm/COMPARE @@ -0,0 +1,88 @@ + +Script started on Thu Sep 28 15:41:06 1989 +% uname -a +titan titan 4_0 UMIPS mips +% make all x-dbm + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbm.c + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c sdbm.c + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c pair.c + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c hash.c + ar cr libsdbm.a sdbm.o pair.o hash.o + ranlib libsdbm.a + cc -o dbm dbm.o libsdbm.a + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dba.c + cc -o dba dba.o + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbd.c + cc -o dbd dbd.o + cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -o x-dbm dbm.o +% +% +% wc history + 65110 218344 3204883 history +% +% /bin/time dbm build foo <history + +real 5:56.9 +user 13.3 +sys 26.3 +% ls -s +total 14251 + 5 README 2 dbd.c 1 hash.c 1 pair.h + 0 SCRIPT 5 dbd.o 1 hash.o 5 pair.o + 1 WISHLIST 62 dbm 3130 history 1 port.h + 46 dba 5 dbm.c 11 howtodbm.txt 11 sdbm.c + 3 dba.c 8 dbm.o 14 libsdbm.a 2 sdbm.h + 6 dba.o 4 foo.dir 1 makefile 8 sdbm.o + 46 dbd 10810 foo.pag 6 pair.c 60 x-dbm +% ls -l foo.* +-rw-r--r-- 1 oz 4096 Sep 28 15:48 foo.dir +-rw-r--r-- 1 oz 11069440 Sep 28 15:48 foo.pag +% +% /bin/time x-dbm build bar <history + +real 5:59.4 +user 24.7 +sys 29.1 +% +% ls -s +total 27612 + 5 README 46 dbd 1 hash.c 5 pair.o + 1 SCRIPT 2 dbd.c 1 hash.o 1 port.h + 1 WISHLIST 5 dbd.o 3130 history 11 sdbm.c + 4 bar.dir 62 dbm 11 howtodbm.txt 2 sdbm.h +13356 bar.pag 5 dbm.c 14 libsdbm.a 8 sdbm.o + 46 dba 8 dbm.o 1 makefile 60 x-dbm + 3 dba.c 4 foo.dir 6 pair.c + 6 dba.o 10810 foo.pag 1 pair.h +% +% ls -l bar.* +-rw-r--r-- 1 oz 4096 Sep 28 15:54 bar.dir +-rw-r--r-- 1 oz 13676544 Sep 28 15:54 bar.pag +% +% dba foo | tail +#10801: ok. no entries. +#10802: ok. no entries. +#10803: ok. no entries. +#10804: ok. no entries. +#10805: ok. no entries. +#10806: ok. no entries. +#10807: ok. no entries. +#10808: ok. no entries. +#10809: ok. 11 entries 67% used free 337. +10810 pages (6036 holes): 65073 entries +% +% dba bar | tail +#13347: ok. no entries. +#13348: ok. no entries. +#13349: ok. no entries. +#13350: ok. no entries. +#13351: ok. no entries. +#13352: ok. no entries. +#13353: ok. no entries. +#13354: ok. no entries. +#13355: ok. 7 entries 33% used free 676. +13356 pages (8643 holes): 65073 entries +% +% exit +script done on Thu Sep 28 16:08:45 1989 + diff --git a/ext/dbm/sdbm/README b/ext/dbm/sdbm/README new file mode 100644 index 0000000000..cd7312cc57 --- /dev/null +++ b/ext/dbm/sdbm/README @@ -0,0 +1,396 @@ + + + + + + + sdbm - Substitute DBM + or + Berkeley ndbm for Every UN*X[1] Made Simple + + Ozan (oz) Yigit + + The Guild of PD Software Toolmakers + Toronto - Canada + + oz@nexus.yorku.ca + + + +Implementation is the sincerest form of flattery. - L. Peter +Deutsch + +A The Clone of the ndbm library + + The sources accompanying this notice - sdbm - consti- +tute the first public release (Dec. 1990) of a complete +clone of the Berkeley UN*X ndbm library. The sdbm library is +meant to clone the proven functionality of ndbm as closely +as possible, including a few improvements. It is practical, +easy to understand, and compatible. The sdbm library is not +derived from any licensed, proprietary or copyrighted +software. + + The sdbm implementation is based on a 1978 algorithm +[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''. +In the course of searching for a substitute for ndbm, I pro- +totyped three different external-hashing algorithms [Lar78, +Fag79, Lit80] and ultimately chose Larson's algorithm as a +basis of the sdbm implementation. The Bell Labs dbm (and +therefore ndbm) is based on an algorithm invented by Ken +Thompson, [Tho90, Tor87] and predates Larson's work. + + The sdbm programming interface is totally compatible +with ndbm and includes a slight improvement in database ini- +tialization. It is also expected to be binary-compatible +under most UN*X versions that support the ndbm library. + + The sdbm implementation shares the shortcomings of the +ndbm library, as a side effect of various simplifications to +the original Larson algorithm. It does produce holes in the +page file as it writes pages past the end of file. (Larson's +paper include a clever solution to this problem that is a +result of using the hash value directly as a block address.) +On the other hand, extensive tests seem to indicate that +sdbm creates fewer holes in general, and the resulting page- +files are smaller. The sdbm implementation is also faster +than ndbm in database creation. Unlike the ndbm, the sdbm +_________________________ + + [1] UN*X is not a trademark of any (dis)organization. + + + + + + + + + + - 2 - + + +store operation will not ``wander away'' trying to split its +data pages to insert a datum that cannot (due to elaborate +worst-case situations) be inserted. (It will fail after a +pre-defined number of attempts.) + +Important Compatibility Warning + + The sdbm and ndbm libraries cannot share databases: one +cannot read the (dir/pag) database created by the other. +This is due to the differences between the ndbm and sdbm +algorithms[2], and the hash functions used. It is easy to +convert between the dbm/ndbm databases and sdbm by ignoring +the index completely: see dbd, dbu etc. + + +Notice of Intellectual Property + +The entire sdbm library package, as authored by me, Ozan S. +Yigit, is hereby placed in the public domain. As such, the +author is not responsible for the consequences of use of +this software, no matter how awful, even if they arise from +defects in it. There is no expressed or implied warranty for +the sdbm library. + + Since the sdbm library package is in the public domain, +this original release or any additional public-domain +releases of the modified original cannot possibly (by defin- +ition) be withheld from you. Also by definition, You (singu- +lar) have all the rights to this code (including the right +to sell without permission, the right to hoard[3] and the +right to do other icky things as you see fit) but those +rights are also granted to everyone else. + + Please note that all previous distributions of this +software contained a copyright (which is now dropped) to +protect its origins and its current public domain status +against any possible claims and/or challenges. + +Acknowledgments + + Many people have been very helpful and supportive. A +partial list would necessarily include Rayan Zacherissen +(who contributed the man page, and also hacked a MMAP +_________________________ + + [2] Torek's discussion [Tor87] indicates that +dbm/ndbm implementations use the hash value to traverse +the radix trie differently than sdbm and as a result, +the page indexes are generated in different order. For +more information, send e-mail to the author. + [3] You cannot really hoard something that is avail- +able to the public at large, but try if it makes you +feel any better. + + + + + + + + + + + - 3 - + + +version of sdbm), Arnold Robbins, Chris Lewis, Bill David- +sen, Henry Spencer, Geoff Collyer, Rich Salz (who got me +started in the first place), Johannes Ruschein (who did the +minix port) and David Tilbrook. I thank you all. + +Distribution Manifest and Notes + +This distribution of sdbm includes (at least) the following: + + CHANGES change log + README this file. + biblio a small bibliography on external hashing + dba.c a crude (n/s)dbm page file analyzer + dbd.c a crude (n/s)dbm page file dumper (for conversion) + dbe.1 man page for dbe.c + dbe.c Janick's database editor + dbm.c a dbm library emulation wrapper for ndbm/sdbm + dbm.h header file for the above + dbu.c a crude db management utility + hash.c hashing function + makefile guess. + pair.c page-level routines (posted earlier) + pair.h header file for the above + readme.ms troff source for the README file + sdbm.3 man page + sdbm.c the real thing + sdbm.h header file for the above + tune.h place for tuning & portability thingies + util.c miscellaneous + + dbu is a simple database manipulation program[4] that +tries to look like Bell Labs' cbt utility. It is currently +incomplete in functionality. I use dbu to test out the rou- +tines: it takes (from stdin) tab separated key/value pairs +for commands like build or insert or takes keys for commands +like delete or look. + + dbu <build|creat|look|insert|cat|delete> dbmfile + + dba is a crude analyzer of dbm/sdbm/ndbm page files. It +scans the entire page file, reporting page level statistics, +and totals at the end. + + dbd is a crude dump program for dbm/ndbm/sdbm data- +bases. It ignores the bitmap, and dumps the data pages in +sequence. It can be used to create input for the dbu util- +ity. Note that dbd will skip any NULLs in the key and data +fields, thus is unsuitable to convert some peculiar +_________________________ + + [4] The dbd, dba, dbu utilities are quick hacks and +are not fit for production use. They were developed +late one night, just to test out sdbm, and convert some +databases. + + + + + + + + + + - 4 - + + +databases that insist in including the terminating null. + + I have also included a copy of the dbe (ndbm DataBase +Editor) by Janick Bergeron [janick@bnr.ca] for your pleas- +ure. You may find it more useful than the little dbu util- +ity. + + dbm.[ch] is a dbm library emulation on top of ndbm (and +hence suitable for sdbm). Written by Robert Elz. + + The sdbm library has been around in beta test for quite +a long time, and from whatever little feedback I received +(maybe no news is good news), I believe it has been func- +tioning without any significant problems. I would, of +course, appreciate all fixes and/or improvements. Portabil- +ity enhancements would especially be useful. + +Implementation Issues + + Hash functions: The algorithm behind sdbm implementa- +tion needs a good bit-scrambling hash function to be effec- +tive. I ran into a set of constants for a simple hash func- +tion that seem to help sdbm perform better than ndbm for +various inputs: + + /* + * polynomial conversion ignoring overflows + * 65599 nice. 65587 even better. + */ + long + dbm_hash(char *str, int len) { + register unsigned long n = 0; + + while (len--) + n = n * 65599 + *str++; + return n; + } + + There may be better hash functions for the purposes of +dynamic hashing. Try your favorite, and check the pagefile. +If it contains too many pages with too many holes, (in rela- +tion to this one for example) or if sdbm simply stops work- +ing (fails after SPLTMAX attempts to split) when you feed +your NEWS history file to it, you probably do not have a +good hashing function. If you do better (for different +types of input), I would like to know about the function you +use. + + Block sizes: It seems (from various tests on a few +machines) that a page file block size PBLKSIZ of 1024 is by +far the best for performance, but this also happens to limit +the size of a key/value pair. Depending on your needs, you +may wish to increase the page size, and also adjust PAIRMAX +(the maximum size of a key/value pair allowed: should always + + + + + + + + + + - 5 - + + +be at least three words smaller than PBLKSIZ.) accordingly. +The system-wide version of the library should probably be +configured with 1024 (distribution default), as this appears +to be sufficient for most common uses of sdbm. + +Portability + + This package has been tested in many different UN*Xes +even including minix, and appears to be reasonably portable. +This does not mean it will port easily to non-UN*X systems. + +Notes and Miscellaneous + + The sdbm is not a very complicated package, at least +not after you familiarize yourself with the literature on +external hashing. There are other interesting algorithms in +existence that ensure (approximately) single-read access to +a data value associated with any key. These are directory- +less schemes such as linear hashing [Lit80] (+ Larson varia- +tions), spiral storage [Mar79] or directory schemes such as +extensible hashing [Fag79] by Fagin et al. I do hope these +sources provide a reasonable playground for experimentation +with other algorithms. See the June 1988 issue of ACM Com- +puting Surveys [Enb88] for an excellent overview of the +field. + +References + + +[Lar78] + P.-A. Larson, ``Dynamic Hashing'', BIT, vol. 18, pp. + 184-201, 1978. + +[Tho90] + Ken Thompson, private communication, Nov. 1990 + +[Lit80] + W. Litwin, `` Linear Hashing: A new tool for file and + table addressing'', Proceedings of the 6th Conference on + Very Large Dabatases (Montreal), pp. 212-223, Very + Large Database Foundation, Saratoga, Calif., 1980. + +[Fag79] + R. Fagin, J. Nievergelt, N. Pippinger, and H. R. + Strong, ``Extendible Hashing - A Fast Access Method for + Dynamic Files'', ACM Trans. Database Syst., vol. 4, + no.3, pp. 315-344, Sept. 1979. + +[Wal84] + Rich Wales, ``Discussion of "dbm" data base system'', + USENET newsgroup unix.wizards, Jan. 1984. + +[Tor87] + Chris Torek, ``Re: dbm.a and ndbm.a archives'', + + + + + + + + + + - 6 - + + + USENET newsgroup comp.unix, 1987. + +[Mar79] + G. N. Martin, ``Spiral Storage: Incrementally Augment- + able Hash Addressed Storage'', Technical Report #27, + University of Varwick, Coventry, U.K., 1979. + +[Enb88] + R. J. Enbody and H. C. Du, ``Dynamic Hashing + Schemes'',ACM Computing Surveys, vol. 20, no. 2, pp. + 85-113, June 1988. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/ext/dbm/sdbm/README.too b/ext/dbm/sdbm/README.too new file mode 100644 index 0000000000..d60ccf0f4b --- /dev/null +++ b/ext/dbm/sdbm/README.too @@ -0,0 +1,3 @@ +This version of sdbm merely has all the dbm_* names translated to sdbm_* +so that we can link ndbm and sdbm into the same executable. (It also has +the bad() macro redefined to allow a zero-length key.) diff --git a/ext/dbm/sdbm/biblio b/ext/dbm/sdbm/biblio new file mode 100644 index 0000000000..0be09fa005 --- /dev/null +++ b/ext/dbm/sdbm/biblio @@ -0,0 +1,64 @@ +%A R. J. Enbody +%A H. C. Du +%T Dynamic Hashing Schemes +%J ACM Computing Surveys +%V 20 +%N 2 +%D June 1988 +%P 85-113 +%K surveys + +%A P.-A. Larson +%T Dynamic Hashing +%J BIT +%V 18 +%P 184-201 +%D 1978 +%K dynamic + +%A W. Litwin +%T Linear Hashing: A new tool for file and table addressing +%J Proceedings of the 6th Conference on Very Large Dabatases (Montreal) +%I Very Large Database Foundation +%C Saratoga, Calif. +%P 212-223 +%D 1980 +%K linear + +%A R. Fagin +%A J. Nievergelt +%A N. Pippinger +%A H. R. Strong +%T Extendible Hashing - A Fast Access Method for Dynamic Files +%J ACM Trans. Database Syst. +%V 4 +%N 3 +%D Sept. 1979 +%P 315-344 +%K extend + +%A G. N. Martin +%T Spiral Storage: Incrementally Augmentable Hash Addressed Storage +%J Technical Report #27 +%I University of Varwick +%C Coventry, U.K. +%D 1979 +%K spiral + +%A Chris Torek +%T Re: dbm.a and ndbm.a archives +%B USENET newsgroup comp.unix +%D 1987 +%K torek + +%A Rich Wales +%T Discusson of "dbm" data base system +%B USENET newsgroup unix.wizards +%D Jan. 1984 +%K rich + + + + + + diff --git a/ext/dbm/sdbm/dba.c b/ext/dbm/sdbm/dba.c new file mode 100644 index 0000000000..4f227e5245 --- /dev/null +++ b/ext/dbm/sdbm/dba.c @@ -0,0 +1,84 @@ +/* + * dba dbm analysis/recovery + */ + +#include <stdio.h> +#include <sys/file.h> +#include "sdbm.h" + +char *progname; +extern void oops(); + +int +main(argc, argv) +char **argv; +{ + int n; + char *p; + char *name; + int pagf; + + progname = argv[0]; + + if (p = argv[1]) { + name = (char *) malloc((n = strlen(p)) + 5); + strcpy(name, p); + strcpy(name + n, ".pag"); + + if ((pagf = open(name, O_RDONLY)) < 0) + oops("cannot open %s.", name); + + sdump(pagf); + } + else + oops("usage: %s dbname", progname); + + return 0; +} + +sdump(pagf) +int pagf; +{ + register b; + register n = 0; + register t = 0; + register o = 0; + register e; + char pag[PBLKSIZ]; + + while ((b = read(pagf, pag, PBLKSIZ)) > 0) { + printf("#%d: ", n); + if (!okpage(pag)) + printf("bad\n"); + else { + printf("ok. "); + if (!(e = pagestat(pag))) + o++; + else + t += e; + } + n++; + } + + if (b == 0) + printf("%d pages (%d holes): %d entries\n", n, o, t); + else + oops("read failed: block %d", n); +} + +pagestat(pag) +char *pag; +{ + register n; + register free; + register short *ino = (short *) pag; + + if (!(n = ino[0])) + printf("no entries.\n"); + else { + free = ino[n] - (n + 1) * sizeof(short); + printf("%3d entries %2d%% used free %d.\n", + n / 2, ((PBLKSIZ - free) * 100) / PBLKSIZ, free); + } + return n / 2; +} diff --git a/ext/dbm/sdbm/dbd.c b/ext/dbm/sdbm/dbd.c new file mode 100644 index 0000000000..697a547597 --- /dev/null +++ b/ext/dbm/sdbm/dbd.c @@ -0,0 +1,110 @@ +/* + * dbd - dump a dbm data file + */ + +#include <stdio.h> +#include <sys/file.h> +#include "sdbm.h" + +char *progname; +extern void oops(); + + +#define empty(page) (((short *) page)[0] == 0) + +int +main(argc, argv) +char **argv; +{ + int n; + char *p; + char *name; + int pagf; + + progname = argv[0]; + + if (p = argv[1]) { + name = (char *) malloc((n = strlen(p)) + 5); + strcpy(name, p); + strcpy(name + n, ".pag"); + + if ((pagf = open(name, O_RDONLY)) < 0) + oops("cannot open %s.", name); + + sdump(pagf); + } + else + oops("usage: %s dbname", progname); + return 0; +} + +sdump(pagf) +int pagf; +{ + register r; + register n = 0; + register o = 0; + char pag[PBLKSIZ]; + + while ((r = read(pagf, pag, PBLKSIZ)) > 0) { + if (!okpage(pag)) + fprintf(stderr, "%d: bad page.\n", n); + else if (empty(pag)) + o++; + else + dispage(pag); + n++; + } + + if (r == 0) + fprintf(stderr, "%d pages (%d holes).\n", n, o); + else + oops("read failed: block %d", n); +} + + +#ifdef OLD +dispage(pag) +char *pag; +{ + register i, n; + register off; + register short *ino = (short *) pag; + + off = PBLKSIZ; + for (i = 1; i < ino[0]; i += 2) { + printf("\t[%d]: ", ino[i]); + for (n = ino[i]; n < off; n++) + putchar(pag[n]); + putchar(' '); + off = ino[i]; + printf("[%d]: ", ino[i + 1]); + for (n = ino[i + 1]; n < off; n++) + putchar(pag[n]); + off = ino[i + 1]; + putchar('\n'); + } +} +#else +dispage(pag) +char *pag; +{ + register i, n; + register off; + register short *ino = (short *) pag; + + off = PBLKSIZ; + for (i = 1; i < ino[0]; i += 2) { + for (n = ino[i]; n < off; n++) + if (pag[n] != 0) + putchar(pag[n]); + putchar('\t'); + off = ino[i]; + for (n = ino[i + 1]; n < off; n++) + if (pag[n] != 0) + putchar(pag[n]); + putchar('\n'); + off = ino[i + 1]; + } +} +#endif diff --git a/ext/dbm/sdbm/dbe.1 b/ext/dbm/sdbm/dbe.1 new file mode 100644 index 0000000000..3b32272684 --- /dev/null +++ b/ext/dbm/sdbm/dbe.1 @@ -0,0 +1,46 @@ +.TH dbe 1 "ndbm(3) EDITOR" +.SH NAME +dbe \- Edit a ndbm(3) database +.SH USAGE +dbe <database> [-m r|w|rw] [-crtvx] -a|-d|-f|-F|-s [<key> [<content>]] +.SH DESCRIPTION +\fIdbme\fP operates on ndbm(3) databases. +It can be used to create them, look at them or change them. +When specifying the value of a key or the content of its associated entry, +\\nnn, \\0, \\n, \\t, \\f and \\r are interpreted as usual. +When displaying key/content pairs, non-printable characters are displayed +using the \\nnn notation. +.SH OPTIONS +.IP -a +List all entries in the database. +.IP -c +Create the database if it does not exist. +.IP -d +Delete the entry associated with the specified key. +.IP -f +Fetch and display the entry associated with the specified key. +.IP -F +Fetch and display all the entries whose key match the specified +regular-expression +.IP "-m r|w|rw" +Open the database in read-only, write-only or read-write mode +.IP -r +Replace the entry associated with the specified key if it already exists. +See option -s. +.IP -s +Store an entry under a specific key. +An error occurs if the key already exists and the option -r was not specified. +.IP -t +Re-initialize the database before executing the command. +.IP -v +Verbose mode. +Confirm stores and deletions. +.IP -x +If option -x is used with option -c, then if the database already exists, +an error occurs. +This can be used to implement a simple exclusive access locking mechanism. +.SH SEE ALSO +ndbm(3) +.SH AUTHOR +janick@bnr.ca + diff --git a/ext/dbm/sdbm/dbe.c b/ext/dbm/sdbm/dbe.c new file mode 100644 index 0000000000..2a306f276e --- /dev/null +++ b/ext/dbm/sdbm/dbe.c @@ -0,0 +1,435 @@ +#include <stdio.h> +#ifndef VMS +#include <sys/file.h> +#include <ndbm.h> +#else +#include "file.h" +#include "ndbm.h" +#endif +#include <ctype.h> + +/***************************************************************************\ +** ** +** Function name: getopt() ** +** Author: Henry Spencer, UofT ** +** Coding date: 84/04/28 ** +** ** +** Description: ** +** ** +** Parses argv[] for arguments. ** +** Works with Whitesmith's C compiler. ** +** ** +** Inputs - The number of arguments ** +** - The base address of the array of arguments ** +** - A string listing the valid options (':' indicates an ** +** argument to the preceding option is required, a ';' ** +** indicates an argument to the preceding option is optional) ** +** ** +** Outputs - Returns the next option character, ** +** '?' for non '-' arguments ** +** or ':' when there is no more arguments. ** +** ** +** Side Effects + The argument to an option is pointed to by 'optarg' ** +** ** +***************************************************************************** +** ** +** REVISION HISTORY: ** +** ** +** DATE NAME DESCRIPTION ** +** YY/MM/DD ------------------ ------------------------------------ ** +** 88/10/20 Janick Bergeron Returns '?' on unamed arguments ** +** returns '!' on unknown options ** +** and 'EOF' only when exhausted. ** +** 88/11/18 Janick Bergeron Return ':' when no more arguments ** +** 89/08/11 Janick Bergeron Optional optarg when ';' in optstring ** +** ** +\***************************************************************************/ + +char *optarg; /* Global argument pointer. */ + +#ifdef VMS +#define index strchr +#endif + +char +getopt(argc, argv, optstring) +int argc; +char **argv; +char *optstring; +{ + register int c; + register char *place; + extern char *index(); + static int optind = 0; + static char *scan = NULL; + + optarg = NULL; + + if (scan == NULL || *scan == '\0') { + + if (optind == 0) + optind++; + if (optind >= argc) + return ':'; + + optarg = place = argv[optind++]; + if (place[0] != '-' || place[1] == '\0') + return '?'; + if (place[1] == '-' && place[2] == '\0') + return '?'; + scan = place + 1; + } + + c = *scan++; + place = index(optstring, c); + if (place == NULL || c == ':' || c == ';') { + + (void) fprintf(stderr, "%s: unknown option %c\n", argv[0], c); + scan = NULL; + return '!'; + } + if (*++place == ':') { + + if (*scan != '\0') { + + optarg = scan; + scan = NULL; + + } + else { + + if (optind >= argc) { + + (void) fprintf(stderr, "%s: %c requires an argument\n", + argv[0], c); + return '!'; + } + optarg = argv[optind]; + optind++; + } + } + else if (*place == ';') { + + if (*scan != '\0') { + + optarg = scan; + scan = NULL; + + } + else { + + if (optind >= argc || *argv[optind] == '-') + optarg = NULL; + else { + optarg = argv[optind]; + optind++; + } + } + } + return c; +} + + +void +print_datum(db) +datum db; +{ + int i; + + putchar('"'); + for (i = 0; i < db.dsize; i++) { + if (isprint(db.dptr[i])) + putchar(db.dptr[i]); + else { + putchar('\\'); + putchar('0' + ((db.dptr[i] >> 6) & 0x07)); + putchar('0' + ((db.dptr[i] >> 3) & 0x07)); + putchar('0' + (db.dptr[i] & 0x07)); + } + } + putchar('"'); +} + + +datum +read_datum(s) +char *s; +{ + datum db; + char *p; + int i; + + db.dsize = 0; + db.dptr = (char *) malloc(strlen(s) * sizeof(char)); + for (p = db.dptr; *s != '\0'; p++, db.dsize++, s++) { + if (*s == '\\') { + if (*++s == 'n') + *p = '\n'; + else if (*s == 'r') + *p = '\r'; + else if (*s == 'f') + *p = '\f'; + else if (*s == 't') + *p = '\t'; + else if (isdigit(*s) && isdigit(*(s + 1)) && isdigit(*(s + 2))) { + i = (*s++ - '0') << 6; + i |= (*s++ - '0') << 3; + i |= *s - '0'; + *p = i; + } + else if (*s == '0') + *p = '\0'; + else + *p = *s; + } + else + *p = *s; + } + + return db; +} + + +char * +key2s(db) +datum db; +{ + char *buf; + char *p1, *p2; + + buf = (char *) malloc((db.dsize + 1) * sizeof(char)); + for (p1 = buf, p2 = db.dptr; *p2 != '\0'; *p1++ = *p2++); + *p1 = '\0'; + return buf; +} + + +main(argc, argv) +int argc; +char **argv; +{ + typedef enum { + YOW, FETCH, STORE, DELETE, SCAN, REGEXP + } commands; + char opt; + int flags; + int giveusage = 0; + int verbose = 0; + commands what = YOW; + char *comarg[3]; + int st_flag = DBM_INSERT; + int argn; + DBM *db; + datum key; + datum content; + + flags = O_RDWR; + argn = 0; + + while ((opt = getopt(argc, argv, "acdfFm:rstvx")) != ':') { + switch (opt) { + case 'a': + what = SCAN; + break; + case 'c': + flags |= O_CREAT; + break; + case 'd': + what = DELETE; + break; + case 'f': + what = FETCH; + break; + case 'F': + what = REGEXP; + break; + case 'm': + flags &= ~(000007); + if (strcmp(optarg, "r") == 0) + flags |= O_RDONLY; + else if (strcmp(optarg, "w") == 0) + flags |= O_WRONLY; + else if (strcmp(optarg, "rw") == 0) + flags |= O_RDWR; + else { + fprintf(stderr, "Invalid mode: \"%s\"\n", optarg); + giveusage = 1; + } + break; + case 'r': + st_flag = DBM_REPLACE; + break; + case 's': + what = STORE; + break; + case 't': + flags |= O_TRUNC; + break; + case 'v': + verbose = 1; + break; + case 'x': + flags |= O_EXCL; + break; + case '!': + giveusage = 1; + break; + case '?': + if (argn < 3) + comarg[argn++] = optarg; + else { + fprintf(stderr, "Too many arguments.\n"); + giveusage = 1; + } + break; + } + } + + if (giveusage | what == YOW | argn < 1) { + fprintf(stderr, "Usage: %s databse [-m r|w|rw] [-crtx] -a|-d|-f|-F|-s [key [content]]\n", argv[0]); + exit(-1); + } + + if ((db = dbm_open(comarg[0], flags, 0777)) == NULL) { + fprintf(stderr, "Error opening database \"%s\"\n", comarg[0]); + exit(-1); + } + + if (argn > 1) + key = read_datum(comarg[1]); + if (argn > 2) + content = read_datum(comarg[2]); + + switch (what) { + + case SCAN: + key = dbm_firstkey(db); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching first key\n"); + goto db_exit; + } + while (key.dptr != NULL) { + content = dbm_fetch(db, key); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching "); + print_datum(key); + printf("\n"); + goto db_exit; + } + print_datum(key); + printf(": "); + print_datum(content); + printf("\n"); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching next key\n"); + goto db_exit; + } + key = dbm_nextkey(db); + } + break; + + case REGEXP: + if (argn < 2) { + fprintf(stderr, "Missing regular expression.\n"); + goto db_exit; + } + if (re_comp(comarg[1])) { + fprintf(stderr, "Invalid regular expression\n"); + goto db_exit; + } + key = dbm_firstkey(db); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching first key\n"); + goto db_exit; + } + while (key.dptr != NULL) { + if (re_exec(key2s(key))) { + content = dbm_fetch(db, key); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching "); + print_datum(key); + printf("\n"); + goto db_exit; + } + print_datum(key); + printf(": "); + print_datum(content); + printf("\n"); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching next key\n"); + goto db_exit; + } + } + key = dbm_nextkey(db); + } + break; + + case FETCH: + if (argn < 2) { + fprintf(stderr, "Missing fetch key.\n"); + goto db_exit; + } + content = dbm_fetch(db, key); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching "); + print_datum(key); + printf("\n"); + goto db_exit; + } + if (content.dptr == NULL) { + fprintf(stderr, "Cannot find "); + print_datum(key); + printf("\n"); + goto db_exit; + } + print_datum(key); + printf(": "); + print_datum(content); + printf("\n"); + break; + + case DELETE: + if (argn < 2) { + fprintf(stderr, "Missing delete key.\n"); + goto db_exit; + } + if (dbm_delete(db, key) || dbm_error(db)) { + fprintf(stderr, "Error when deleting "); + print_datum(key); + printf("\n"); + goto db_exit; + } + if (verbose) { + print_datum(key); + printf(": DELETED\n"); + } + break; + + case STORE: + if (argn < 3) { + fprintf(stderr, "Missing key and/or content.\n"); + goto db_exit; + } + if (dbm_store(db, key, content, st_flag) || dbm_error(db)) { + fprintf(stderr, "Error when storing "); + print_datum(key); + printf("\n"); + goto db_exit; + } + if (verbose) { + print_datum(key); + printf(": "); + print_datum(content); + printf(" STORED\n"); + } + break; + } + +db_exit: + dbm_clearerr(db); + dbm_close(db); + if (dbm_error(db)) { + fprintf(stderr, "Error closing database \"%s\"\n", comarg[0]); + exit(-1); + } +} diff --git a/ext/dbm/sdbm/dbm.c b/ext/dbm/sdbm/dbm.c new file mode 100644 index 0000000000..1388230e2d --- /dev/null +++ b/ext/dbm/sdbm/dbm.c @@ -0,0 +1,120 @@ +/* + * Copyright (c) 1985 The Regents of the University of California. + * All rights reserved. + * + * Redistribution and use in source and binary forms are permitted + * provided that the above copyright notice and this paragraph are + * duplicated in all such forms and that any documentation, + * advertising materials, and other materials related to such + * distribution and use acknowledge that the software was developed + * by the University of California, Berkeley. The name of the + * University may not be used to endorse or promote products derived + * from this software without specific prior written permission. + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + */ + +#ifndef lint +static char sccsid[] = "@(#)dbm.c 5.4 (Berkeley) 5/24/89"; +#endif /* not lint */ + +#include "dbm.h" + +#define NODB ((DBM *)0) + +static DBM *cur_db = NODB; + +static char no_db[] = "dbm: no open database\n"; + +dbminit(file) + char *file; +{ + if (cur_db != NODB) + dbm_close(cur_db); + + cur_db = dbm_open(file, 2, 0); + if (cur_db == NODB) { + cur_db = dbm_open(file, 0, 0); + if (cur_db == NODB) + return (-1); + } + return (0); +} + +long +forder(key) +datum key; +{ + if (cur_db == NODB) { + printf(no_db); + return (0L); + } + return (dbm_forder(cur_db, key)); +} + +datum +fetch(key) +datum key; +{ + datum item; + + if (cur_db == NODB) { + printf(no_db); + item.dptr = 0; + return (item); + } + return (dbm_fetch(cur_db, key)); +} + +delete(key) +datum key; +{ + if (cur_db == NODB) { + printf(no_db); + return (-1); + } + if (dbm_rdonly(cur_db)) + return (-1); + return (dbm_delete(cur_db, key)); +} + +store(key, dat) +datum key, dat; +{ + if (cur_db == NODB) { + printf(no_db); + return (-1); + } + if (dbm_rdonly(cur_db)) + return (-1); + + return (dbm_store(cur_db, key, dat, DBM_REPLACE)); +} + +datum +firstkey() +{ + datum item; + + if (cur_db == NODB) { + printf(no_db); + item.dptr = 0; + return (item); + } + return (dbm_firstkey(cur_db)); +} + +datum +nextkey(key) +datum key; +{ + datum item; + + if (cur_db == NODB) { + printf(no_db); + item.dptr = 0; + return (item); + } + return (dbm_nextkey(cur_db, key)); +} diff --git a/ext/dbm/sdbm/dbm.h b/ext/dbm/sdbm/dbm.h new file mode 100644 index 0000000000..dce48fed07 --- /dev/null +++ b/ext/dbm/sdbm/dbm.h @@ -0,0 +1,33 @@ +/* + * Copyright (c) 1983 The Regents of the University of California. + * All rights reserved. + * + * Redistribution and use in source and binary forms are permitted + * provided that the above copyright notice and this paragraph are + * duplicated in all such forms and that any documentation, + * advertising materials, and other materials related to such + * distribution and use acknowledge that the software was developed + * by the University of California, Berkeley. The name of the + * University may not be used to endorse or promote products derived + * from this software without specific prior written permission. + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + * + * @(#)dbm.h 5.2 (Berkeley) 5/24/89 + */ + +#ifndef NULL +/* + * this is lunacy, we no longer use it (and never should have + * unconditionally defined it), but, this whole file is for + * backwards compatability - someone may rely on this. + */ +#define NULL ((char *) 0) +#endif + +#include <ndbm.h> + +datum fetch(); +datum firstkey(); +datum nextkey(); diff --git a/ext/dbm/sdbm/dbu.c b/ext/dbm/sdbm/dbu.c new file mode 100644 index 0000000000..106262872e --- /dev/null +++ b/ext/dbm/sdbm/dbu.c @@ -0,0 +1,250 @@ +#include <stdio.h> +#include <sys/file.h> +#ifdef SDBM +#include "sdbm.h" +#else +#include <ndbm.h> +#endif +#include <string.h> + +#ifdef BSD42 +#define strchr index +#endif + +extern int getopt(); +extern char *strchr(); +extern void oops(); + +char *progname; + +static int rflag; +static char *usage = "%s [-R] cat | look |... dbmname"; + +#define DERROR 0 +#define DLOOK 1 +#define DINSERT 2 +#define DDELETE 3 +#define DCAT 4 +#define DBUILD 5 +#define DPRESS 6 +#define DCREAT 7 + +#define LINEMAX 8192 + +typedef struct { + char *sname; + int scode; + int flags; +} cmd; + +static cmd cmds[] = { + + "fetch", DLOOK, O_RDONLY, + "get", DLOOK, O_RDONLY, + "look", DLOOK, O_RDONLY, + "add", DINSERT, O_RDWR, + "insert", DINSERT, O_RDWR, + "store", DINSERT, O_RDWR, + "delete", DDELETE, O_RDWR, + "remove", DDELETE, O_RDWR, + "dump", DCAT, O_RDONLY, + "list", DCAT, O_RDONLY, + "cat", DCAT, O_RDONLY, + "creat", DCREAT, O_RDWR | O_CREAT | O_TRUNC, + "new", DCREAT, O_RDWR | O_CREAT | O_TRUNC, + "build", DBUILD, O_RDWR | O_CREAT, + "squash", DPRESS, O_RDWR, + "compact", DPRESS, O_RDWR, + "compress", DPRESS, O_RDWR +}; + +#define CTABSIZ (sizeof (cmds)/sizeof (cmd)) + +static cmd *parse(); +static void badk(), doit(), prdatum(); + +int +main(argc, argv) +int argc; +char *argv[]; +{ + int c; + register cmd *act; + extern int optind; + extern char *optarg; + + progname = argv[0]; + + while ((c = getopt(argc, argv, "R")) != EOF) + switch (c) { + case 'R': /* raw processing */ + rflag++; + break; + + default: + oops("usage: %s", usage); + break; + } + + if ((argc -= optind) < 2) + oops("usage: %s", usage); + + if ((act = parse(argv[optind])) == NULL) + badk(argv[optind]); + optind++; + doit(act, argv[optind]); + return 0; +} + +static void +doit(act, file) +register cmd *act; +char *file; +{ + datum key; + datum val; + register DBM *db; + register char *op; + register int n; + char *line; +#ifdef TIME + long start; + extern long time(); +#endif + + if ((db = dbm_open(file, act->flags, 0644)) == NULL) + oops("cannot open: %s", file); + + if ((line = (char *) malloc(LINEMAX)) == NULL) + oops("%s: cannot get memory", "line alloc"); + + switch (act->scode) { + + case DLOOK: + while (fgets(line, LINEMAX, stdin) != NULL) { + n = strlen(line) - 1; + line[n] = 0; + key.dptr = line; + key.dsize = n; + val = dbm_fetch(db, key); + if (val.dptr != NULL) { + prdatum(stdout, val); + putchar('\n'); + continue; + } + prdatum(stderr, key); + fprintf(stderr, ": not found.\n"); + } + break; + case DINSERT: + break; + case DDELETE: + while (fgets(line, LINEMAX, stdin) != NULL) { + n = strlen(line) - 1; + line[n] = 0; + key.dptr = line; + key.dsize = n; + if (dbm_delete(db, key) == -1) { + prdatum(stderr, key); + fprintf(stderr, ": not found.\n"); + } + } + break; + case DCAT: + for (key = dbm_firstkey(db); key.dptr != 0; + key = dbm_nextkey(db)) { + prdatum(stdout, key); + putchar('\t'); + prdatum(stdout, dbm_fetch(db, key)); + putchar('\n'); + } + break; + case DBUILD: +#ifdef TIME + start = time(0); +#endif + while (fgets(line, LINEMAX, stdin) != NULL) { + n = strlen(line) - 1; + line[n] = 0; + key.dptr = line; + if ((op = strchr(line, '\t')) != 0) { + key.dsize = op - line; + *op++ = 0; + val.dptr = op; + val.dsize = line + n - op; + } + else + oops("bad input; %s", line); + + if (dbm_store(db, key, val, DBM_REPLACE) < 0) { + prdatum(stderr, key); + fprintf(stderr, ": "); + oops("store: %s", "failed"); + } + } +#ifdef TIME + printf("done: %d seconds.\n", time(0) - start); +#endif + break; + case DPRESS: + break; + case DCREAT: + break; + } + + dbm_close(db); +} + +static void +badk(word) +char *word; +{ + register int i; + + if (progname) + fprintf(stderr, "%s: ", progname); + fprintf(stderr, "bad keywd %s. use one of\n", word); + for (i = 0; i < (int)CTABSIZ; i++) + fprintf(stderr, "%-8s%c", cmds[i].sname, + ((i + 1) % 6 == 0) ? '\n' : ' '); + fprintf(stderr, "\n"); + exit(1); + /*NOTREACHED*/ +} + +static cmd * +parse(str) +register char *str; +{ + register int i = CTABSIZ; + register cmd *p; + + for (p = cmds; i--; p++) + if (strcmp(p->sname, str) == 0) + return p; + return NULL; +} + +static void +prdatum(stream, d) +FILE *stream; +datum d; +{ + register int c; + register char *p = d.dptr; + register int n = d.dsize; + + while (n--) { + c = *p++ & 0377; + if (c & 0200) { + fprintf(stream, "M-"); + c &= 0177; + } + if (c == 0177 || c < ' ') + fprintf(stream, "^%c", (c == 0177) ? '?' : c + '@'); + else + putc(c, stream); + } +} + + diff --git a/ext/dbm/sdbm/grind b/ext/dbm/sdbm/grind new file mode 100755 index 0000000000..23728b7d49 --- /dev/null +++ b/ext/dbm/sdbm/grind @@ -0,0 +1,9 @@ +#!/bin/sh +rm -f /tmp/*.dir /tmp/*.pag +awk -e '{ + printf "%s\t", $0 + for (i = 0; i < 40; i++) + printf "%s.", $0 + printf "\n" +}' < /usr/dict/words | $1 build /tmp/$2 + diff --git a/ext/dbm/sdbm/hash.c b/ext/dbm/sdbm/hash.c new file mode 100644 index 0000000000..9b55a7f571 --- /dev/null +++ b/ext/dbm/sdbm/hash.c @@ -0,0 +1,47 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. keep it that way. + * + * hashing routine + */ + +#include "sdbm.h" +/* + * polynomial conversion ignoring overflows + * [this seems to work remarkably well, in fact better + * then the ndbm hash function. Replace at your own risk] + * use: 65599 nice. + * 65587 even better. + */ +long +sdbm_hash(str, len) +register char *str; +register int len; +{ + register unsigned long n = 0; + +#ifdef DUFF + +#define HASHC n = *str++ + 65599 * n + + if (len > 0) { + register int loop = (len + 8 - 1) >> 3; + + switch(len & (8 - 1)) { + case 0: do { + HASHC; case 7: HASHC; + case 6: HASHC; case 5: HASHC; + case 4: HASHC; case 3: HASHC; + case 2: HASHC; case 1: HASHC; + } while (--loop); + } + + } +#else + while (len--) + n = *str++ + 65599 * n; +#endif + return n; +} diff --git a/ext/dbm/sdbm/linux.patches b/ext/dbm/sdbm/linux.patches new file mode 100644 index 0000000000..cb7b1b7d8e --- /dev/null +++ b/ext/dbm/sdbm/linux.patches @@ -0,0 +1,67 @@ +*** sdbm.dist/./dbu.c Mon Feb 17 21:18:52 1992 +--- sdbm/./dbu.c Mon Feb 17 21:11:20 1992 +*************** +*** 12,18 **** + #endif + + extern int getopt(); +! extern char *strchr(); + extern void oops(); + + char *progname; +--- 12,18 ---- + #endif + + extern int getopt(); +! /* extern char *strchr(); */ + extern void oops(); + + char *progname; +*** sdbm.dist/./makefile Mon Feb 17 21:18:56 1992 +--- sdbm/./makefile Mon Feb 17 21:10:46 1992 +*************** +*** 2,8 **** + # makefile for public domain ndbm-clone: sdbm + # DUFF: use duff's device (loop unroll) in parts of the code + # +! CFLAGS = -O -DSDBM -DDUFF -DBSD42 + #LDFLAGS = -p + + OBJS = sdbm.o pair.o hash.o +--- 2,8 ---- + # makefile for public domain ndbm-clone: sdbm + # DUFF: use duff's device (loop unroll) in parts of the code + # +! CFLAGS = -O -DSDBM -DDUFF + #LDFLAGS = -p + + OBJS = sdbm.o pair.o hash.o +*** sdbm.dist/./sdbm.c Mon Feb 17 21:19:17 1992 +--- sdbm/./sdbm.c Mon Feb 17 21:12:59 1992 +*************** +*** 25,30 **** +--- 25,31 ---- + #endif + #include <errno.h> + #include <string.h> ++ #include <unistd.h> + + #ifdef __STDC__ + #include <stddef.h> +*************** +*** 43,49 **** + + extern char *malloc proto((unsigned int)); + extern void free proto((void *)); +! extern long lseek(); + + /* + * forward +--- 44,50 ---- + + extern char *malloc proto((unsigned int)); + extern void free proto((void *)); +! /* extern long lseek(); */ + + /* + * forward diff --git a/ext/dbm/sdbm/makefile b/ext/dbm/sdbm/makefile new file mode 100644 index 0000000000..5dabe40242 --- /dev/null +++ b/ext/dbm/sdbm/makefile @@ -0,0 +1,55 @@ +# +# makefile for public domain ndbm-clone: sdbm +# DUFF: use duff's device (loop unroll) in parts of the code +# +CFLAGS = -O -DSDBM -DDUFF -DBSD42 +#LDFLAGS = -p + +OBJS = sdbm.o pair.o hash.o +SRCS = sdbm.c pair.c hash.c dbu.c dba.c dbd.c util.c +HDRS = tune.h sdbm.h pair.h +MISC = README CHANGES COMPARE sdbm.3 dbe.c dbe.1 dbm.c dbm.h biblio \ + readme.ms readme.ps + +all: dbu dba dbd dbe + +dbu: dbu.o sdbm util.o + cc $(LDFLAGS) -o dbu dbu.o util.o libsdbm.a + +dba: dba.o util.o + cc $(LDFLAGS) -o dba dba.o util.o +dbd: dbd.o util.o + cc $(LDFLAGS) -o dbd dbd.o util.o +dbe: dbe.o sdbm + cc $(LDFLAGS) -o dbe dbe.o libsdbm.a + +sdbm: $(OBJS) + ar cr libsdbm.a $(OBJS) + ranlib libsdbm.a +### cp libsdbm.a /usr/lib/libsdbm.a + +dba.o: sdbm.h +dbu.o: sdbm.h +util.o:sdbm.h + +$(OBJS): sdbm.h tune.h pair.h + +# +# dbu using berkelezoid ndbm routines [if you have them] for testing +# +#x-dbu: dbu.o util.o +# cc $(CFLAGS) -o x-dbu dbu.o util.o +lint: + lint -abchx $(SRCS) + +clean: + rm -f *.o mon.out core + +purge: clean + rm -f dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag + +shar: + shar $(MISC) makefile $(SRCS) $(HDRS) >SDBM.SHAR + +readme: + nroff -ms readme.ms | col -b >README diff --git a/ext/dbm/sdbm/pair.c b/ext/dbm/sdbm/pair.c new file mode 100644 index 0000000000..a3941716d9 --- /dev/null +++ b/ext/dbm/sdbm/pair.c @@ -0,0 +1,308 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. + * + * page-level routines + */ + +#ifndef lint +static char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $"; +#endif + +#include "sdbm.h" +#include "tune.h" +#include "pair.h" + +#ifndef BSD42 +#include <memory.h> +#endif + +#define exhash(item) sdbm_hash((item).dptr, (item).dsize) + +/* + * forward + */ +static int seepair proto((char *, int, char *, int)); + +/* + * page format: + * +------------------------------+ + * ino | n | keyoff | datoff | keyoff | + * +------------+--------+--------+ + * | datoff | - - - ----> | + * +--------+---------------------+ + * | F R E E A R E A | + * +--------------+---------------+ + * | <---- - - - | data | + * +--------+-----+----+----------+ + * | key | data | key | + * +--------+----------+----------+ + * + * calculating the offsets for free area: if the number + * of entries (ino[0]) is zero, the offset to the END of + * the free area is the block size. Otherwise, it is the + * nth (ino[ino[0]]) entry's offset. + */ + +int +fitpair(pag, need) +char *pag; +int need; +{ + register int n; + register int off; + register int free; + register short *ino = (short *) pag; + + off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; + free = off - (n + 1) * sizeof(short); + need += 2 * sizeof(short); + + debug(("free %d need %d\n", free, need)); + + return need <= free; +} + +void +putpair(pag, key, val) +char *pag; +datum key; +datum val; +{ + register int n; + register int off; + register short *ino = (short *) pag; + + off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; +/* + * enter the key first + */ + off -= key.dsize; + (void) memcpy(pag + off, key.dptr, key.dsize); + ino[n + 1] = off; +/* + * now the data + */ + off -= val.dsize; + (void) memcpy(pag + off, val.dptr, val.dsize); + ino[n + 2] = off; +/* + * adjust item count + */ + ino[0] += 2; +} + +datum +getpair(pag, key) +char *pag; +datum key; +{ + register int i; + register int n; + datum val; + register short *ino = (short *) pag; + + if ((n = ino[0]) == 0) + return nullitem; + + if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) + return nullitem; + + val.dptr = pag + ino[i + 1]; + val.dsize = ino[i] - ino[i + 1]; + return val; +} + +#ifdef SEEDUPS +int +duppair(pag, key) +char *pag; +datum key; +{ + register short *ino = (short *) pag; + return ino[0] > 0 && seepair(pag, ino[0], key.dptr, key.dsize) > 0; +} +#endif + +datum +getnkey(pag, num) +char *pag; +int num; +{ + datum key; + register int off; + register short *ino = (short *) pag; + + num = num * 2 - 1; + if (ino[0] == 0 || num > ino[0]) + return nullitem; + + off = (num > 1) ? ino[num - 1] : PBLKSIZ; + + key.dptr = pag + ino[num]; + key.dsize = off - ino[num]; + + return key; +} + +int +delpair(pag, key) +char *pag; +datum key; +{ + register int n; + register int i; + register short *ino = (short *) pag; + + if ((n = ino[0]) == 0) + return 0; + + if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) + return 0; +/* + * found the key. if it is the last entry + * [i.e. i == n - 1] we just adjust the entry count. + * hard case: move all data down onto the deleted pair, + * shift offsets onto deleted offsets, and adjust them. + * [note: 0 < i < n] + */ + if (i < n - 1) { + register int m; + register char *dst = pag + (i == 1 ? PBLKSIZ : ino[i - 1]); + register char *src = pag + ino[i + 1]; + register int zoo = dst - src; + + debug(("free-up %d ", zoo)); +/* + * shift data/keys down + */ + m = ino[i + 1] - ino[n]; +#ifdef DUFF +#define MOVB *--dst = *--src + + if (m > 0) { + register int loop = (m + 8 - 1) >> 3; + + switch (m & (8 - 1)) { + case 0: do { + MOVB; case 7: MOVB; + case 6: MOVB; case 5: MOVB; + case 4: MOVB; case 3: MOVB; + case 2: MOVB; case 1: MOVB; + } while (--loop); + } + } +#else +#ifdef MEMMOVE + memmove(dst, src, m); +#else + while (m--) + *--dst = *--src; +#endif +#endif +/* + * adjust offset index up + */ + while (i < n - 1) { + ino[i] = ino[i + 2] + zoo; + i++; + } + } + ino[0] -= 2; + return 1; +} + +/* + * search for the key in the page. + * return offset index in the range 0 < i < n. + * return 0 if not found. + */ +static int +seepair(pag, n, key, siz) +char *pag; +register int n; +register char *key; +register int siz; +{ + register int i; + register int off = PBLKSIZ; + register short *ino = (short *) pag; + + for (i = 1; i < n; i += 2) { + if (siz == off - ino[i] && + memcmp(key, pag + ino[i], siz) == 0) + return i; + off = ino[i + 1]; + } + return 0; +} + +void +splpage(pag, new, sbit) +char *pag; +char *new; +long sbit; +{ + datum key; + datum val; + + register int n; + register int off = PBLKSIZ; + char cur[PBLKSIZ]; + register short *ino = (short *) cur; + + (void) memcpy(cur, pag, PBLKSIZ); + (void) memset(pag, 0, PBLKSIZ); + (void) memset(new, 0, PBLKSIZ); + + n = ino[0]; + for (ino++; n > 0; ino += 2) { + key.dptr = cur + ino[0]; + key.dsize = off - ino[0]; + val.dptr = cur + ino[1]; + val.dsize = ino[0] - ino[1]; +/* + * select the page pointer (by looking at sbit) and insert + */ + (void) putpair((exhash(key) & sbit) ? new : pag, key, val); + + off = ino[1]; + n -= 2; + } + + debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, + ((short *) new)[0] / 2, + ((short *) pag)[0] / 2)); +} + +/* + * check page sanity: + * number of entries should be something + * reasonable, and all offsets in the index should be in order. + * this could be made more rigorous. + */ +int +chkpage(pag) +char *pag; +{ + register int n; + register int off; + register short *ino = (short *) pag; + + if ((n = ino[0]) < 0 || n > PBLKSIZ / sizeof(short)) + return 0; + + if (n > 0) { + off = PBLKSIZ; + for (ino++; n > 0; ino += 2) { + if (ino[0] > off || ino[1] > off || + ino[1] > ino[0]) + return 0; + off = ino[1]; + n -= 2; + } + } + return 1; +} diff --git a/ext/dbm/sdbm/pair.h b/ext/dbm/sdbm/pair.h new file mode 100644 index 0000000000..bd66d02fd2 --- /dev/null +++ b/ext/dbm/sdbm/pair.h @@ -0,0 +1,10 @@ +extern int fitpair proto((char *, int)); +extern void putpair proto((char *, datum, datum)); +extern datum getpair proto((char *, datum)); +extern int delpair proto((char *, datum)); +extern int chkpage proto((char *)); +extern datum getnkey proto((char *, int)); +extern void splpage proto((char *, char *, long)); +#ifdef SEEDUPS +extern int duppair proto((char *, datum)); +#endif diff --git a/ext/dbm/sdbm/readme.ms b/ext/dbm/sdbm/readme.ms new file mode 100644 index 0000000000..01ca17ccdf --- /dev/null +++ b/ext/dbm/sdbm/readme.ms @@ -0,0 +1,353 @@ +.\" tbl | readme.ms | [tn]roff -ms | ... +.\" note the "C" (courier) and "CB" fonts: you will probably have to +.\" change these. +.\" $Id: readme.ms,v 1.1 90/12/13 13:09:15 oz Exp Locker: oz $ + +.de P1 +.br +.nr dT 4 +.nf +.ft C +.sp .5 +.nr t \\n(dT*\\w'x'u +.ta 1u*\\ntu 2u*\\ntu 3u*\\ntu 4u*\\ntu 5u*\\ntu 6u*\\ntu 7u*\\ntu 8u*\\ntu 9u*\\ntu 10u*\\ntu 11u*\\ntu 12u*\\ntu 13u*\\ntu 14u*\\ntu +.. +.de P2 +.br +.ft 1 +.br +.sp .5 +.br +.fi +.. +.\" CW uses the typewriter/courier font. +.de CW +\fC\\$1\\fP\\$2 +.. + +.\" Footnote numbering [by Henry Spencer] +.\" <text>\*f for a footnote number.. +.\" .FS +.\" \*F <footnote text> +.\" .FE +.\" +.ds f \\u\\s-2\\n+f\\s+2\\d +.nr f 0 1 +.ds F \\n+F. +.nr F 0 1 + +.ND +.LP +.TL +\fIsdbm\fP \(em Substitute DBM +.br +or +.br +Berkeley \fIndbm\fP for Every UN*X\** Made Simple +.AU +Ozan (oz) Yigit +.AI +The Guild of PD Software Toolmakers +Toronto - Canada +.sp +oz@nexus.yorku.ca +.LP +.FS +UN*X is not a trademark of any (dis)organization. +.FE +.sp 2 +\fIImplementation is the sincerest form of flattery. \(em L. Peter Deutsch\fP +.SH +A The Clone of the \fIndbm\fP library +.PP +The sources accompanying this notice \(em \fIsdbm\fP \(em constitute +the first public release (Dec. 1990) of a complete clone of +the Berkeley UN*X \fIndbm\fP library. The \fIsdbm\fP library is meant to +clone the proven functionality of \fIndbm\fP as closely as possible, +including a few improvements. It is practical, easy to understand, and +compatible. +The \fIsdbm\fP library is not derived from any licensed, proprietary or +copyrighted software. +.PP +The \fIsdbm\fP implementation is based on a 1978 algorithm +[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''. +In the course of searching for a substitute for \fIndbm\fP, I +prototyped three different external-hashing algorithms [Lar78, Fag79, Lit80] +and ultimately chose Larson's algorithm as a basis of the \fIsdbm\fP +implementation. The Bell Labs +\fIdbm\fP (and therefore \fIndbm\fP) is based on an algorithm invented by +Ken Thompson, [Tho90, Tor87] and predates Larson's work. +.PP +The \fIsdbm\fR programming interface is totally compatible +with \fIndbm\fP and includes a slight improvement in database initialization. +It is also expected to be binary-compatible under most UN*X versions that +support the \fIndbm\fP library. +.PP +The \fIsdbm\fP implementation shares the shortcomings of the \fIndbm\fP +library, as a side effect of various simplifications to the original Larson +algorithm. It does produce \fIholes\fP in the page file as it writes +pages past the end of file. (Larson's paper include a clever solution to +this problem that is a result of using the hash value directly as a block +address.) On the other hand, extensive tests seem to indicate that \fIsdbm\fP +creates fewer holes in general, and the resulting pagefiles are +smaller. The \fIsdbm\fP implementation is also faster than \fIndbm\fP +in database creation. +Unlike the \fIndbm\fP, the \fIsdbm\fP +.CW store +operation will not ``wander away'' trying to split its +data pages to insert a datum that \fIcannot\fP (due to elaborate worst-case +situations) be inserted. (It will fail after a pre-defined number of attempts.) +.SH +Important Compatibility Warning +.PP +The \fIsdbm\fP and \fIndbm\fP +libraries \fIcannot\fP share databases: one cannot read the (dir/pag) +database created by the other. This is due to the differences +between the \fIndbm\fP and \fIsdbm\fP algorithms\**, +.FS +Torek's discussion [Tor87] +indicates that \fIdbm/ndbm\fP implementations use the hash +value to traverse the radix trie differently than \fIsdbm\fP +and as a result, the page indexes are generated in \fIdifferent\fP order. +For more information, send e-mail to the author. +.FE +and the hash functions +used. +It is easy to convert between the \fIdbm/ndbm\fP databases and \fIsdbm\fP +by ignoring the index completely: see +.CW dbd , +.CW dbu +etc. +.R +.LP +.SH +Notice of Intellectual Property +.LP +\fIThe entire\fP sdbm \fIlibrary package, as authored by me,\fP Ozan S. Yigit, +\fIis hereby placed in the public domain.\fP As such, the author is not +responsible for the consequences of use of this software, no matter how +awful, even if they arise from defects in it. There is no expressed or +implied warranty for the \fIsdbm\fP library. +.PP +Since the \fIsdbm\fP +library package is in the public domain, this \fIoriginal\fP +release or any additional public-domain releases of the modified original +cannot possibly (by definition) be withheld from you. Also by definition, +You (singular) have all the rights to this code (including the right to +sell without permission, the right to hoard\** +.FS +You cannot really hoard something that is available to the public at +large, but try if it makes you feel any better. +.FE +and the right to do other icky things as +you see fit) but those rights are also granted to everyone else. +.PP +Please note that all previous distributions of this software contained +a copyright (which is now dropped) to protect its +origins and its current public domain status against any possible claims +and/or challenges. +.SH +Acknowledgments +.PP +Many people have been very helpful and supportive. A partial list would +necessarily include Rayan Zacherissen (who contributed the man page, +and also hacked a MMAP version of \fIsdbm\fP), +Arnold Robbins, Chris Lewis, +Bill Davidsen, Henry Spencer, Geoff Collyer, Rich Salz (who got me started +in the first place), Johannes Ruschein +(who did the minix port) and David Tilbrook. I thank you all. +.SH +Distribution Manifest and Notes +.LP +This distribution of \fIsdbm\fP includes (at least) the following: +.P1 + CHANGES change log + README this file. + biblio a small bibliography on external hashing + dba.c a crude (n/s)dbm page file analyzer + dbd.c a crude (n/s)dbm page file dumper (for conversion) + dbe.1 man page for dbe.c + dbe.c Janick's database editor + dbm.c a dbm library emulation wrapper for ndbm/sdbm + dbm.h header file for the above + dbu.c a crude db management utility + hash.c hashing function + makefile guess. + pair.c page-level routines (posted earlier) + pair.h header file for the above + readme.ms troff source for the README file + sdbm.3 man page + sdbm.c the real thing + sdbm.h header file for the above + tune.h place for tuning & portability thingies + util.c miscellaneous +.P2 +.PP +.CW dbu +is a simple database manipulation program\** that tries to look +.FS +The +.CW dbd , +.CW dba , +.CW dbu +utilities are quick hacks and are not fit for production use. They were +developed late one night, just to test out \fIsdbm\fP, and convert some +databases. +.FE +like Bell Labs' +.CW cbt +utility. It is currently incomplete in functionality. +I use +.CW dbu +to test out the routines: it takes (from stdin) tab separated +key/value pairs for commands like +.CW build +or +.CW insert +or takes keys for +commands like +.CW delete +or +.CW look . +.P1 + dbu <build|creat|look|insert|cat|delete> dbmfile +.P2 +.PP +.CW dba +is a crude analyzer of \fIdbm/sdbm/ndbm\fP +page files. It scans the entire +page file, reporting page level statistics, and totals at the end. +.PP +.CW dbd +is a crude dump program for \fIdbm/ndbm/sdbm\fP +databases. It ignores the +bitmap, and dumps the data pages in sequence. It can be used to create +input for the +.CW dbu +utility. +Note that +.CW dbd +will skip any NULLs in the key and data +fields, thus is unsuitable to convert some peculiar databases that +insist in including the terminating null. +.PP +I have also included a copy of the +.CW dbe +(\fIndbm\fP DataBase Editor) by Janick Bergeron [janick@bnr.ca] for +your pleasure. You may find it more useful than the little +.CW dbu +utility. +.PP +.CW dbm.[ch] +is a \fIdbm\fP library emulation on top of \fIndbm\fP +(and hence suitable for \fIsdbm\fP). Written by Robert Elz. +.PP +The \fIsdbm\fP +library has been around in beta test for quite a long time, and from whatever +little feedback I received (maybe no news is good news), I believe it has been +functioning without any significant problems. I would, of course, appreciate +all fixes and/or improvements. Portability enhancements would especially be +useful. +.SH +Implementation Issues +.PP +Hash functions: +The algorithm behind \fIsdbm\fP implementation needs a good bit-scrambling +hash function to be effective. I ran into a set of constants for a simple +hash function that seem to help \fIsdbm\fP perform better than \fIndbm\fP +for various inputs: +.P1 + /* + * polynomial conversion ignoring overflows + * 65599 nice. 65587 even better. + */ + long + dbm_hash(char *str, int len) { + register unsigned long n = 0; + + while (len--) + n = n * 65599 + *str++; + return n; + } +.P2 +.PP +There may be better hash functions for the purposes of dynamic hashing. +Try your favorite, and check the pagefile. If it contains too many pages +with too many holes, (in relation to this one for example) or if +\fIsdbm\fP +simply stops working (fails after +.CW SPLTMAX +attempts to split) when you feed your +NEWS +.CW history +file to it, you probably do not have a good hashing function. +If you do better (for different types of input), I would like to know +about the function you use. +.PP +Block sizes: It seems (from various tests on a few machines) that a page +file block size +.CW PBLKSIZ +of 1024 is by far the best for performance, but +this also happens to limit the size of a key/value pair. Depending on your +needs, you may wish to increase the page size, and also adjust +.CW PAIRMAX +(the maximum size of a key/value pair allowed: should always be at least +three words smaller than +.CW PBLKSIZ .) +accordingly. The system-wide version of the library +should probably be +configured with 1024 (distribution default), as this appears to be sufficient +for most common uses of \fIsdbm\fP. +.SH +Portability +.PP +This package has been tested in many different UN*Xes even including minix, +and appears to be reasonably portable. This does not mean it will port +easily to non-UN*X systems. +.SH +Notes and Miscellaneous +.PP +The \fIsdbm\fP is not a very complicated package, at least not after you +familiarize yourself with the literature on external hashing. There are +other interesting algorithms in existence that ensure (approximately) +single-read access to a data value associated with any key. These are +directory-less schemes such as \fIlinear hashing\fP [Lit80] (+ Larson +variations), \fIspiral storage\fP [Mar79] or directory schemes such as +\fIextensible hashing\fP [Fag79] by Fagin et al. I do hope these sources +provide a reasonable playground for experimentation with other algorithms. +See the June 1988 issue of ACM Computing Surveys [Enb88] for an +excellent overview of the field. +.PG +.SH +References +.LP +.IP [Lar78] 4m +P.-A. Larson, +``Dynamic Hashing'', \fIBIT\fP, vol. 18, pp. 184-201, 1978. +.IP [Tho90] 4m +Ken Thompson, \fIprivate communication\fP, Nov. 1990 +.IP [Lit80] 4m +W. Litwin, +`` Linear Hashing: A new tool for file and table addressing'', +\fIProceedings of the 6th Conference on Very Large Dabatases (Montreal)\fP, +pp. 212-223, Very Large Database Foundation, Saratoga, Calif., 1980. +.IP [Fag79] 4m +R. Fagin, J. Nievergelt, N. Pippinger, and H. R. Strong, +``Extendible Hashing - A Fast Access Method for Dynamic Files'', +\fIACM Trans. Database Syst.\fP, vol. 4, no.3, pp. 315-344, Sept. 1979. +.IP [Wal84] 4m +Rich Wales, +``Discussion of "dbm" data base system'', \fIUSENET newsgroup unix.wizards\fP, +Jan. 1984. +.IP [Tor87] 4m +Chris Torek, +``Re: dbm.a and ndbm.a archives'', \fIUSENET newsgroup comp.unix\fP, +1987. +.IP [Mar79] 4m +G. N. Martin, +``Spiral Storage: Incrementally Augmentable Hash Addressed Storage'', +\fITechnical Report #27\fP, University of Varwick, Coventry, U.K., 1979. +.IP [Enb88] 4m +R. J. Enbody and H. C. Du, +``Dynamic Hashing Schemes'',\fIACM Computing Surveys\fP, +vol. 20, no. 2, pp. 85-113, June 1988. diff --git a/ext/dbm/sdbm/readme.ps b/ext/dbm/sdbm/readme.ps new file mode 100644 index 0000000000..2b0c675595 --- /dev/null +++ b/ext/dbm/sdbm/readme.ps @@ -0,0 +1,2225 @@ +%!PS-Adobe-1.0 +%%Creator: yetti:oz (Ozan Yigit) +%%Title: stdin (ditroff) +%%CreationDate: Thu Dec 13 15:56:08 1990 +%%EndComments +% lib/psdit.pro -- prolog for psdit (ditroff) files +% Copyright (c) 1984, 1985 Adobe Systems Incorporated. All Rights Reserved. +% last edit: shore Sat Nov 23 20:28:03 1985 +% RCSID: $Header: psdit.pro,v 2.1 85/11/24 12:19:43 shore Rel $ + +/$DITroff 140 dict def $DITroff begin +/fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def +/xi {0 72 11 mul translate 72 resolution div dup neg scale 0 0 moveto + /fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def F + /pagesave save def}def +/PB{save /psv exch def currentpoint translate + resolution 72 div dup neg scale 0 0 moveto}def +/PE{psv restore}def +/arctoobig 90 def /arctoosmall .05 def +/m1 matrix def /m2 matrix def /m3 matrix def /oldmat matrix def +/tan{dup sin exch cos div}def +/point{resolution 72 div mul}def +/dround {transform round exch round exch itransform}def +/xT{/devname exch def}def +/xr{/mh exch def /my exch def /resolution exch def}def +/xp{}def +/xs{docsave restore end}def +/xt{}def +/xf{/fontname exch def /slotno exch def fontnames slotno get fontname eq not + {fonts slotno fontname findfont put fontnames slotno fontname put}if}def +/xH{/fontheight exch def F}def +/xS{/fontslant exch def F}def +/s{/fontsize exch def /fontheight fontsize def F}def +/f{/fontnum exch def F}def +/F{fontheight 0 le {/fontheight fontsize def}if + fonts fontnum get fontsize point 0 0 fontheight point neg 0 0 m1 astore + fontslant 0 ne{1 0 fontslant tan 1 0 0 m2 astore m3 concatmatrix}if + makefont setfont .04 fontsize point mul 0 dround pop setlinewidth}def +/X{exch currentpoint exch pop moveto show}def +/N{3 1 roll moveto show}def +/Y{exch currentpoint pop exch moveto show}def +/S{show}def +/ditpush{}def/ditpop{}def +/AX{3 -1 roll currentpoint exch pop moveto 0 exch ashow}def +/AN{4 2 roll moveto 0 exch ashow}def +/AY{3 -1 roll currentpoint pop exch moveto 0 exch ashow}def +/AS{0 exch ashow}def +/MX{currentpoint exch pop moveto}def +/MY{currentpoint pop exch moveto}def +/MXY{moveto}def +/cb{pop}def % action on unknown char -- nothing for now +/n{}def/w{}def +/p{pop showpage pagesave restore /pagesave save def}def +/abspoint{currentpoint exch pop add exch currentpoint pop add exch}def +/distance{dup mul exch dup mul add sqrt}def +/dstroke{currentpoint stroke moveto}def +/Dl{2 copy gsave rlineto stroke grestore rmoveto}def +/arcellipse{/diamv exch def /diamh exch def oldmat currentmatrix pop + currentpoint translate 1 diamv diamh div scale /rad diamh 2 div def + currentpoint exch rad add exch rad -180 180 arc oldmat setmatrix}def +/Dc{dup arcellipse dstroke}def +/De{arcellipse dstroke}def +/Da{/endv exch def /endh exch def /centerv exch def /centerh exch def + /cradius centerv centerv mul centerh centerh mul add sqrt def + /eradius endv endv mul endh endh mul add sqrt def + /endang endv endh atan def + /startang centerv neg centerh neg atan def + /sweep startang endang sub dup 0 lt{360 add}if def + sweep arctoobig gt + {/midang startang sweep 2 div sub def /midrad cradius eradius add 2 div def + /midh midang cos midrad mul def /midv midang sin midrad mul def + midh neg midv neg endh endv centerh centerv midh midv Da + currentpoint moveto Da} + {sweep arctoosmall ge + {/controldelt 1 sweep 2 div cos sub 3 sweep 2 div sin mul div 4 mul def + centerv neg controldelt mul centerh controldelt mul + endv neg controldelt mul centerh add endh add + endh controldelt mul centerv add endv add + centerh endh add centerv endv add rcurveto dstroke} + {centerh endh add centerv endv add rlineto dstroke}ifelse}ifelse}def + +/Barray 200 array def % 200 values in a wiggle +/D~{mark}def +/D~~{counttomark Barray exch 0 exch getinterval astore /Bcontrol exch def pop + /Blen Bcontrol length def Blen 4 ge Blen 2 mod 0 eq and + {Bcontrol 0 get Bcontrol 1 get abspoint /Ycont exch def /Xcont exch def + Bcontrol 0 2 copy get 2 mul put Bcontrol 1 2 copy get 2 mul put + Bcontrol Blen 2 sub 2 copy get 2 mul put + Bcontrol Blen 1 sub 2 copy get 2 mul put + /Ybi /Xbi currentpoint 3 1 roll def def 0 2 Blen 4 sub + {/i exch def + Bcontrol i get 3 div Bcontrol i 1 add get 3 div + Bcontrol i get 3 mul Bcontrol i 2 add get add 6 div + Bcontrol i 1 add get 3 mul Bcontrol i 3 add get add 6 div + /Xbi Xcont Bcontrol i 2 add get 2 div add def + /Ybi Ycont Bcontrol i 3 add get 2 div add def + /Xcont Xcont Bcontrol i 2 add get add def + /Ycont Ycont Bcontrol i 3 add get add def + Xbi currentpoint pop sub Ybi currentpoint exch pop sub rcurveto + }for dstroke}if}def +end +/ditstart{$DITroff begin + /nfonts 60 def % NFONTS makedev/ditroff dependent! + /fonts[nfonts{0}repeat]def + /fontnames[nfonts{()}repeat]def +/docsave save def +}def + +% character outcalls +/oc {/pswid exch def /cc exch def /name exch def + /ditwid pswid fontsize mul resolution mul 72000 div def + /ditsiz fontsize resolution mul 72 div def + ocprocs name known{ocprocs name get exec}{name cb} + ifelse}def +/fractm [.65 0 0 .6 0 0] def +/fraction + {/fden exch def /fnum exch def gsave /cf currentfont def + cf fractm makefont setfont 0 .3 dm 2 copy neg rmoveto + fnum show rmoveto currentfont cf setfont(\244)show setfont fden show + grestore ditwid 0 rmoveto} def +/oce {grestore ditwid 0 rmoveto}def +/dm {ditsiz mul}def +/ocprocs 50 dict def ocprocs begin +(14){(1)(4)fraction}def +(12){(1)(2)fraction}def +(34){(3)(4)fraction}def +(13){(1)(3)fraction}def +(23){(2)(3)fraction}def +(18){(1)(8)fraction}def +(38){(3)(8)fraction}def +(58){(5)(8)fraction}def +(78){(7)(8)fraction}def +(sr){gsave 0 .06 dm rmoveto(\326)show oce}def +(is){gsave 0 .15 dm rmoveto(\362)show oce}def +(->){gsave 0 .02 dm rmoveto(\256)show oce}def +(<-){gsave 0 .02 dm rmoveto(\254)show oce}def +(==){gsave 0 .05 dm rmoveto(\272)show oce}def +end + +% an attempt at a PostScript FONT to implement ditroff special chars +% this will enable us to +% cache the little buggers +% generate faster, more compact PS out of psdit +% confuse everyone (including myself)! +50 dict dup begin +/FontType 3 def +/FontName /DIThacks def +/FontMatrix [.001 0 0 .001 0 0] def +/FontBBox [-260 -260 900 900] def% a lie but ... +/Encoding 256 array def +0 1 255{Encoding exch /.notdef put}for +Encoding + dup 8#040/space put %space + dup 8#110/rc put %right ceil + dup 8#111/lt put %left top curl + dup 8#112/bv put %bold vert + dup 8#113/lk put %left mid curl + dup 8#114/lb put %left bot curl + dup 8#115/rt put %right top curl + dup 8#116/rk put %right mid curl + dup 8#117/rb put %right bot curl + dup 8#120/rf put %right floor + dup 8#121/lf put %left floor + dup 8#122/lc put %left ceil + dup 8#140/sq put %square + dup 8#141/bx put %box + dup 8#142/ci put %circle + dup 8#143/br put %box rule + dup 8#144/rn put %root extender + dup 8#145/vr put %vertical rule + dup 8#146/ob put %outline bullet + dup 8#147/bu put %bullet + dup 8#150/ru put %rule + dup 8#151/ul put %underline + pop +/DITfd 100 dict def +/BuildChar{0 begin + /cc exch def /fd exch def + /charname fd /Encoding get cc get def + /charwid fd /Metrics get charname get def + /charproc fd /CharProcs get charname get def + charwid 0 fd /FontBBox get aload pop setcachedevice + 2 setlinejoin 40 setlinewidth + newpath 0 0 moveto gsave charproc grestore + end}def +/BuildChar load 0 DITfd put +%/UniqueID 5 def +/CharProcs 50 dict def +CharProcs begin +/space{}def +/.notdef{}def +/ru{500 0 rls}def +/rn{0 840 moveto 500 0 rls}def +/vr{0 800 moveto 0 -770 rls}def +/bv{0 800 moveto 0 -1000 rls}def +/br{0 750 moveto 0 -1000 rls}def +/ul{0 -140 moveto 500 0 rls}def +/ob{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath stroke}def +/bu{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath fill}def +/sq{80 0 rmoveto currentpoint dround newpath moveto + 640 0 rlineto 0 640 rlineto -640 0 rlineto closepath stroke}def +/bx{80 0 rmoveto currentpoint dround newpath moveto + 640 0 rlineto 0 640 rlineto -640 0 rlineto closepath fill}def +/ci{500 360 rmoveto currentpoint newpath 333 0 360 arc + 50 setlinewidth stroke}def + +/lt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 add exch s4 a4p stroke}def +/lb{0 800 moveto 0 -550 rlineto currx -200 2cx s4 add exch s4 a4p stroke}def +/rt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 sub exch s4 a4p stroke}def +/rb{0 800 moveto 0 -500 rlineto currx -200 2cx s4 sub exch s4 a4p stroke}def +/lk{0 800 moveto 0 300 -300 300 s4 arcto pop pop 1000 sub + 0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def +/rk{0 800 moveto 0 300 s2 300 s4 arcto pop pop 1000 sub + 0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def +/lf{0 800 moveto 0 -1000 rlineto s4 0 rls}def +/rf{0 800 moveto 0 -1000 rlineto s4 neg 0 rls}def +/lc{0 -200 moveto 0 1000 rlineto s4 0 rls}def +/rc{0 -200 moveto 0 1000 rlineto s4 neg 0 rls}def +end + +/Metrics 50 dict def Metrics begin +/.notdef 0 def +/space 500 def +/ru 500 def +/br 0 def +/lt 416 def +/lb 416 def +/rt 416 def +/rb 416 def +/lk 416 def +/rk 416 def +/rc 416 def +/lc 416 def +/rf 416 def +/lf 416 def +/bv 416 def +/ob 350 def +/bu 350 def +/ci 750 def +/bx 750 def +/sq 750 def +/rn 500 def +/ul 500 def +/vr 0 def +end + +DITfd begin +/s2 500 def /s4 250 def /s3 333 def +/a4p{arcto pop pop pop pop}def +/2cx{2 copy exch}def +/rls{rlineto stroke}def +/currx{currentpoint pop}def +/dround{transform round exch round exch itransform} def +end +end +/DIThacks exch definefont pop +ditstart +(psc)xT +576 1 1 xr +1(Times-Roman)xf 1 f +2(Times-Italic)xf 2 f +3(Times-Bold)xf 3 f +4(Times-BoldItalic)xf 4 f +5(Helvetica)xf 5 f +6(Helvetica-Bold)xf 6 f +7(Courier)xf 7 f +8(Courier-Bold)xf 8 f +9(Symbol)xf 9 f +10(DIThacks)xf 10 f +10 s +1 f +xi +%%EndProlog + +%%Page: 1 1 +10 s 0 xH 0 xS 1 f +8 s +2 f +12 s +1778 672(sdbm)N +3 f +2004(\320)X +2124(Substitute)X +2563(DBM)X +2237 768(or)N +1331 864(Berkeley)N +2 f +1719(ndbm)X +3 f +1956(for)X +2103(Every)X +2373(UN*X)X +1 f +10 s +2628 832(1)N +3 f +12 s +2692 864(Made)N +2951(Simple)X +2 f +10 s +2041 1056(Ozan)N +2230(\(oz\))X +2375(Yigit)X +1 f +1658 1200(The)N +1803(Guild)X +2005(of)X +2092(PD)X +2214(Software)X +2524(Toolmakers)X +2000 1296(Toronto)N +2278(-)X +2325(Canada)X +1965 1488(oz@nexus.yorku.ca)N +2 f +555 1804(Implementation)N +1078(is)X +1151(the)X +1269(sincerest)X +1574(form)X +1745(of)X +1827(\257attery.)X +2094(\320)X +2185(L.)X +2269(Peter)X +2463(Deutsch)X +3 f +555 1996(A)N +633(The)X +786(Clone)X +1006(of)X +1093(the)X +2 f +1220(ndbm)X +3 f +1418(library)X +1 f +755 2120(The)N +903(sources)X +1167(accompanying)X +1658(this)X +1796(notice)X +2015(\320)X +2 f +2118(sdbm)X +1 f +2309(\320)X +2411(constitute)X +2744(the)X +2864(\256rst)X +3010(public)X +3232(release)X +3478(\(Dec.)X +3677(1990\))X +3886(of)X +3975(a)X +555 2216(complete)N +874(clone)X +1073(of)X +1165(the)X +1288(Berkeley)X +1603(UN*X)X +2 f +1842(ndbm)X +1 f +2045(library.)X +2304(The)X +2 f +2454(sdbm)X +1 f +2648(library)X +2887(is)X +2965(meant)X +3186(to)X +3273(clone)X +3472(the)X +3594(proven)X +3841(func-)X +555 2312(tionality)N +846(of)X +2 f +938(ndbm)X +1 f +1141(as)X +1233(closely)X +1485(as)X +1576(possible,)X +1882(including)X +2208(a)X +2268(few)X +2413(improvements.)X +2915(It)X +2988(is)X +3065(practical,)X +3386(easy)X +3553(to)X +3639(understand,)X +555 2408(and)N +691(compatible.)X +1107(The)X +2 f +1252(sdbm)X +1 f +1441(library)X +1675(is)X +1748(not)X +1870(derived)X +2131(from)X +2307(any)X +2443(licensed,)X +2746(proprietary)X +3123(or)X +3210(copyrighted)X +3613(software.)X +755 2532(The)N +2 f +910(sdbm)X +1 f +1109(implementation)X +1641(is)X +1723(based)X +1935(on)X +2044(a)X +2109(1978)X +2298(algorithm)X +2638([Lar78])X +2913(by)X +3022(P.-A.)X +3220(\(Paul\))X +3445(Larson)X +3697(known)X +3944(as)X +555 2628(``Dynamic)N +934(Hashing''.)X +1326(In)X +1424(the)X +1553(course)X +1794(of)X +1892(searching)X +2231(for)X +2355(a)X +2421(substitute)X +2757(for)X +2 f +2881(ndbm)X +1 f +3059(,)X +3109(I)X +3166(prototyped)X +3543(three)X +3734(different)X +555 2724(external-hashing)N +1119(algorithms)X +1490([Lar78,)X +1758(Fag79,)X +2007(Lit80])X +2236(and)X +2381(ultimately)X +2734(chose)X +2946(Larson's)X +3256(algorithm)X +3596(as)X +3692(a)X +3756(basis)X +3944(of)X +555 2820(the)N +2 f +680(sdbm)X +1 f +875(implementation.)X +1423(The)X +1574(Bell)X +1733(Labs)X +2 f +1915(dbm)X +1 f +2079(\(and)X +2248(therefore)X +2 f +2565(ndbm)X +1 f +2743(\))X +2796(is)X +2875(based)X +3084(on)X +3190(an)X +3292(algorithm)X +3629(invented)X +3931(by)X +555 2916(Ken)N +709(Thompson,)X +1091([Tho90,)X +1367(Tor87])X +1610(and)X +1746(predates)X +2034(Larson's)X +2335(work.)X +755 3040(The)N +2 f +903(sdbm)X +1 f +1095(programming)X +1553(interface)X +1857(is)X +1932(totally)X +2158(compatible)X +2536(with)X +2 f +2700(ndbm)X +1 f +2900(and)X +3038(includes)X +3327(a)X +3385(slight)X +3584(improvement)X +555 3136(in)N +641(database)X +942(initialization.)X +1410(It)X +1483(is)X +1560(also)X +1713(expected)X +2023(to)X +2109(be)X +2208(binary-compatible)X +2819(under)X +3025(most)X +3203(UN*X)X +3440(versions)X +3730(that)X +3873(sup-)X +555 3232(port)N +704(the)X +2 f +822(ndbm)X +1 f +1020(library.)X +755 3356(The)N +2 f +909(sdbm)X +1 f +1107(implementation)X +1638(shares)X +1868(the)X +1995(shortcomings)X +2455(of)X +2551(the)X +2 f +2678(ndbm)X +1 f +2885(library,)X +3148(as)X +3244(a)X +3309(side)X +3467(effect)X +3680(of)X +3775(various)X +555 3452(simpli\256cations)N +1046(to)X +1129(the)X +1248(original)X +1518(Larson)X +1762(algorithm.)X +2114(It)X +2183(does)X +2350(produce)X +2 f +2629(holes)X +1 f +2818(in)X +2900(the)X +3018(page)X +3190(\256le)X +3312(as)X +3399(it)X +3463(writes)X +3679(pages)X +3882(past)X +555 3548(the)N +680(end)X +823(of)X +917(\256le.)X +1066(\(Larson's)X +1400(paper)X +1605(include)X +1867(a)X +1929(clever)X +2152(solution)X +2435(to)X +2523(this)X +2664(problem)X +2957(that)X +3103(is)X +3182(a)X +3244(result)X +3448(of)X +3541(using)X +3740(the)X +3864(hash)X +555 3644(value)N +758(directly)X +1032(as)X +1128(a)X +1193(block)X +1400(address.\))X +1717(On)X +1844(the)X +1971(other)X +2165(hand,)X +2370(extensive)X +2702(tests)X +2873(seem)X +3067(to)X +3158(indicate)X +3441(that)X +2 f +3590(sdbm)X +1 f +3787(creates)X +555 3740(fewer)N +762(holes)X +954(in)X +1039(general,)X +1318(and)X +1456(the)X +1576(resulting)X +1878(page\256les)X +2185(are)X +2306(smaller.)X +2584(The)X +2 f +2731(sdbm)X +1 f +2922(implementation)X +3446(is)X +3521(also)X +3672(faster)X +3873(than)X +2 f +555 3836(ndbm)N +1 f +757(in)X +843(database)X +1144(creation.)X +1467(Unlike)X +1709(the)X +2 f +1831(ndbm)X +1 f +2009(,)X +2053(the)X +2 f +2175(sdbm)X +7 f +2396(store)X +1 f +2660(operation)X +2987(will)X +3134(not)X +3259(``wander)X +3573(away'')X +3820(trying)X +555 3932(to)N +642(split)X +804(its)X +904(data)X +1063(pages)X +1271(to)X +1358(insert)X +1561(a)X +1622(datum)X +1847(that)X +2 f +1992(cannot)X +1 f +2235(\(due)X +2403(to)X +2490(elaborate)X +2810(worst-case)X +3179(situations\))X +3537(be)X +3637(inserted.)X +3935(\(It)X +555 4028(will)N +699(fail)X +826(after)X +994(a)X +1050(pre-de\256ned)X +1436(number)X +1701(of)X +1788(attempts.\))X +3 f +555 4220(Important)N +931(Compatibility)X +1426(Warning)X +1 f +755 4344(The)N +2 f +904(sdbm)X +1 f +1097(and)X +2 f +1237(ndbm)X +1 f +1439(libraries)X +2 f +1726(cannot)X +1 f +1968(share)X +2162(databases:)X +2515(one)X +2654(cannot)X +2891(read)X +3053(the)X +3174(\(dir/pag\))X +3478(database)X +3778(created)X +555 4440(by)N +657(the)X +777(other.)X +984(This)X +1148(is)X +1222(due)X +1359(to)X +1442(the)X +1561(differences)X +1940(between)X +2229(the)X +2 f +2348(ndbm)X +1 f +2547(and)X +2 f +2684(sdbm)X +1 f +2874(algorithms)X +8 s +3216 4415(2)N +10 s +4440(,)Y +3289(and)X +3426(the)X +3545(hash)X +3713(functions)X +555 4536(used.)N +769(It)X +845(is)X +925(easy)X +1094(to)X +1182(convert)X +1449(between)X +1743(the)X +2 f +1867(dbm/ndbm)X +1 f +2231(databases)X +2565(and)X +2 f +2707(sdbm)X +1 f +2902(by)X +3008(ignoring)X +3305(the)X +3429(index)X +3633(completely:)X +555 4632(see)N +7 f +706(dbd)X +1 f +(,)S +7 f +918(dbu)X +1 f +1082(etc.)X +3 f +555 4852(Notice)N +794(of)X +881(Intellectual)X +1288(Property)X +2 f +555 4976(The)N +696(entire)X +1 f +904(sdbm)X +2 f +1118(library)X +1361(package,)X +1670(as)X +1762(authored)X +2072(by)X +2169(me,)X +1 f +2304(Ozan)X +2495(S.)X +2580(Yigit,)X +2 f +2785(is)X +2858(hereby)X +3097(placed)X +3331(in)X +3413(the)X +3531(public)X +3751(domain.)X +1 f +555 5072(As)N +670(such,)X +863(the)X +987(author)X +1218(is)X +1297(not)X +1425(responsible)X +1816(for)X +1936(the)X +2060(consequences)X +2528(of)X +2621(use)X +2754(of)X +2847(this)X +2988(software,)X +3310(no)X +3415(matter)X +3645(how)X +3808(awful,)X +555 5168(even)N +727(if)X +796(they)X +954(arise)X +1126(from)X +1302(defects)X +1550(in)X +1632(it.)X +1716(There)X +1924(is)X +1997(no)X +2097(expressed)X +2434(or)X +2521(implied)X +2785(warranty)X +3091(for)X +3205(the)X +2 f +3323(sdbm)X +1 f +3512(library.)X +8 s +10 f +555 5316(hhhhhhhhhhhhhhhhhh)N +6 s +1 f +635 5391(1)N +8 s +691 5410(UN*X)N +877(is)X +936(not)X +1034(a)X +1078(trademark)X +1352(of)X +1421(any)X +1529(\(dis\)organization.)X +6 s +635 5485(2)N +8 s +691 5504(Torek's)N +908(discussion)X +1194([Tor87])X +1411(indicates)X +1657(that)X +2 f +1772(dbm/ndbm)X +1 f +2061(implementations)X +2506(use)X +2609(the)X +2705(hash)X +2840(value)X +2996(to)X +3064(traverse)X +3283(the)X +3379(radix)X +3528(trie)X +3631(dif-)X +555 5584(ferently)N +772(than)X +2 f +901(sdbm)X +1 f +1055(and)X +1166(as)X +1238(a)X +1285(result,)X +1462(the)X +1559(page)X +1698(indexes)X +1912(are)X +2008(generated)X +2274(in)X +2 f +2343(different)X +1 f +2579(order.)X +2764(For)X +2872(more)X +3021(information,)X +3357(send)X +3492(e-mail)X +3673(to)X +555 5664(the)N +649(author.)X + +2 p +%%Page: 2 2 +8 s 0 xH 0 xS 1 f +10 s +2216 384(-)N +2263(2)X +2323(-)X +755 672(Since)N +971(the)X +2 f +1107(sdbm)X +1 f +1314(library)X +1566(package)X +1868(is)X +1959(in)X +2058(the)X +2193(public)X +2430(domain,)X +2727(this)X +2 f +2879(original)X +1 f +3173(release)X +3434(or)X +3538(any)X +3691(additional)X +555 768(public-domain)N +1045(releases)X +1323(of)X +1413(the)X +1534(modi\256ed)X +1841(original)X +2112(cannot)X +2348(possibly)X +2636(\(by)X +2765(de\256nition\))X +3120(be)X +3218(withheld)X +3520(from)X +3698(you.)X +3860(Also)X +555 864(by)N +659(de\256nition,)X +1009(You)X +1170(\(singular\))X +1505(have)X +1680(all)X +1783(the)X +1904(rights)X +2109(to)X +2194(this)X +2332(code)X +2507(\(including)X +2859(the)X +2980(right)X +3154(to)X +3239(sell)X +3373(without)X +3640(permission,)X +555 960(the)N +679(right)X +856(to)X +944(hoard)X +8 s +1127 935(3)N +10 s +1185 960(and)N +1327(the)X +1451(right)X +1628(to)X +1716(do)X +1821(other)X +2011(icky)X +2174(things)X +2394(as)X +2486(you)X +2631(see)X +2759(\256t\))X +2877(but)X +3004(those)X +3198(rights)X +3405(are)X +3529(also)X +3683(granted)X +3949(to)X +555 1056(everyone)N +870(else.)X +755 1180(Please)N +997(note)X +1172(that)X +1329(all)X +1446(previous)X +1759(distributions)X +2195(of)X +2298(this)X +2449(software)X +2762(contained)X +3110(a)X +3182(copyright)X +3525(\(which)X +3784(is)X +3873(now)X +555 1276(dropped\))N +868(to)X +953(protect)X +1199(its)X +1297(origins)X +1542(and)X +1681(its)X +1779(current)X +2030(public)X +2253(domain)X +2516(status)X +2721(against)X +2970(any)X +3108(possible)X +3392(claims)X +3623(and/or)X +3850(chal-)X +555 1372(lenges.)N +3 f +555 1564(Acknowledgments)N +1 f +755 1688(Many)N +966(people)X +1204(have)X +1380(been)X +1556(very)X +1723(helpful)X +1974(and)X +2114(supportive.)X +2515(A)X +2596(partial)X +2824(list)X +2944(would)X +3167(necessarily)X +3547(include)X +3806(Rayan)X +555 1784(Zacherissen)N +963(\(who)X +1152(contributed)X +1541(the)X +1663(man)X +1824(page,)X +2019(and)X +2158(also)X +2310(hacked)X +2561(a)X +2620(MMAP)X +2887(version)X +3146(of)X +2 f +3236(sdbm)X +1 f +3405(\),)X +3475(Arnold)X +3725(Robbins,)X +555 1880(Chris)N +763(Lewis,)X +1013(Bill)X +1166(Davidsen,)X +1523(Henry)X +1758(Spencer,)X +2071(Geoff)X +2293(Collyer,)X +2587(Rich)X +2772(Salz)X +2944(\(who)X +3143(got)X +3279(me)X +3411(started)X +3659(in)X +3755(the)X +3887(\256rst)X +555 1976(place\),)N +792(Johannes)X +1106(Ruschein)X +1424(\(who)X +1609(did)X +1731(the)X +1849(minix)X +2055(port\))X +2231(and)X +2367(David)X +2583(Tilbrook.)X +2903(I)X +2950(thank)X +3148(you)X +3288(all.)X +3 f +555 2168(Distribution)N +992(Manifest)X +1315(and)X +1463(Notes)X +1 f +555 2292(This)N +717(distribution)X +1105(of)X +2 f +1192(sdbm)X +1 f +1381(includes)X +1668(\(at)X +1773(least\))X +1967(the)X +2085(following:)X +7 f +747 2436(CHANGES)N +1323(change)X +1659(log)X +747 2532(README)N +1323(this)X +1563(file.)X +747 2628(biblio)N +1323(a)X +1419(small)X +1707(bibliography)X +2331(on)X +2475(external)X +2907(hashing)X +747 2724(dba.c)N +1323(a)X +1419(crude)X +1707(\(n/s\)dbm)X +2139(page)X +2379(file)X +2619(analyzer)X +747 2820(dbd.c)N +1323(a)X +1419(crude)X +1707(\(n/s\)dbm)X +2139(page)X +2379(file)X +2619(dumper)X +2955(\(for)X +3195(conversion\))X +747 2916(dbe.1)N +1323(man)X +1515(page)X +1755(for)X +1947(dbe.c)X +747 3012(dbe.c)N +1323(Janick's)X +1755(database)X +2187(editor)X +747 3108(dbm.c)N +1323(a)X +1419(dbm)X +1611(library)X +1995(emulation)X +2475(wrapper)X +2859(for)X +3051(ndbm/sdbm)X +747 3204(dbm.h)N +1323(header)X +1659(file)X +1899(for)X +2091(the)X +2283(above)X +747 3300(dbu.c)N +1323(a)X +1419(crude)X +1707(db)X +1851(management)X +2379(utility)X +747 3396(hash.c)N +1323(hashing)X +1707(function)X +747 3492(makefile)N +1323(guess.)X +747 3588(pair.c)N +1323(page-level)X +1851(routines)X +2283(\(posted)X +2667(earlier\))X +747 3684(pair.h)N +1323(header)X +1659(file)X +1899(for)X +2091(the)X +2283(above)X +747 3780(readme.ms)N +1323(troff)X +1611(source)X +1947(for)X +2139(the)X +2331(README)X +2667(file)X +747 3876(sdbm.3)N +1323(man)X +1515(page)X +747 3972(sdbm.c)N +1323(the)X +1515(real)X +1755(thing)X +747 4068(sdbm.h)N +1323(header)X +1659(file)X +1899(for)X +2091(the)X +2283(above)X +747 4164(tune.h)N +1323(place)X +1611(for)X +1803(tuning)X +2139(&)X +2235(portability)X +2811(thingies)X +747 4260(util.c)N +1323(miscellaneous)X +755 4432(dbu)N +1 f +924(is)X +1002(a)X +1063(simple)X +1301(database)X +1603(manipulation)X +2050(program)X +8 s +2322 4407(4)N +10 s +2379 4432(that)N +2524(tries)X +2687(to)X +2774(look)X +2941(like)X +3086(Bell)X +3244(Labs')X +7 f +3480(cbt)X +1 f +3649(utility.)X +3884(It)X +3958(is)X +555 4528(currently)N +867(incomplete)X +1245(in)X +1329(functionality.)X +1800(I)X +1849(use)X +7 f +2006(dbu)X +1 f +2172(to)X +2255(test)X +2387(out)X +2510(the)X +2629(routines:)X +2930(it)X +2995(takes)X +3181(\(from)X +3385(stdin\))X +3588(tab)X +3707(separated)X +555 4624(key/value)N +898(pairs)X +1085(for)X +1210(commands)X +1587(like)X +7 f +1765(build)X +1 f +2035(or)X +7 f +2160(insert)X +1 f +2478(or)X +2575(takes)X +2770(keys)X +2947(for)X +3071(commands)X +3448(like)X +7 f +3626(delete)X +1 f +3944(or)X +7 f +555 4720(look)N +1 f +(.)S +7 f +747 4864(dbu)N +939(<build|creat|look|insert|cat|delete>)X +2715(dbmfile)X +755 5036(dba)N +1 f +927(is)X +1008(a)X +1072(crude)X +1279(analyzer)X +1580(of)X +2 f +1675(dbm/sdbm/ndbm)X +1 f +2232(page)X +2412(\256les.)X +2593(It)X +2670(scans)X +2872(the)X +2998(entire)X +3209(page)X +3389(\256le,)X +3538(reporting)X +3859(page)X +555 5132(level)N +731(statistics,)X +1046(and)X +1182(totals)X +1375(at)X +1453(the)X +1571(end.)X +7 f +755 5256(dbd)N +1 f +925(is)X +1004(a)X +1066(crude)X +1271(dump)X +1479(program)X +1777(for)X +2 f +1897(dbm/ndbm/sdbm)X +1 f +2452(databases.)X +2806(It)X +2881(ignores)X +3143(the)X +3267(bitmap,)X +3534(and)X +3675(dumps)X +3913(the)X +555 5352(data)N +717(pages)X +928(in)X +1018(sequence.)X +1361(It)X +1437(can)X +1576(be)X +1679(used)X +1853(to)X +1942(create)X +2162(input)X +2353(for)X +2474(the)X +7 f +2627(dbu)X +1 f +2798(utility.)X +3055(Note)X +3238(that)X +7 f +3413(dbd)X +1 f +3584(will)X +3735(skip)X +3895(any)X +8 s +10 f +555 5432(hhhhhhhhhhhhhhhhhh)N +6 s +1 f +635 5507(3)N +8 s +691 5526(You)N +817(cannot)X +1003(really)X +1164(hoard)X +1325(something)X +1608(that)X +1720(is)X +1779(available)X +2025(to)X +2091(the)X +2185(public)X +2361(at)X +2423(large,)X +2582(but)X +2680(try)X +2767(if)X +2822(it)X +2874(makes)X +3053(you)X +3165(feel)X +3276(any)X +3384(better.)X +6 s +635 5601(4)N +8 s +691 5620(The)N +7 f +829(dbd)X +1 f +943(,)X +7 f +998(dba)X +1 f +1112(,)X +7 f +1167(dbu)X +1 f +1298(utilities)X +1508(are)X +1602(quick)X +1761(hacks)X +1923(and)X +2032(are)X +2126(not)X +2225(\256t)X +2295(for)X +2385(production)X +2678(use.)X +2795(They)X +2942(were)X +3081(developed)X +3359(late)X +3467(one)X +3575(night,)X +555 5700(just)N +664(to)X +730(test)X +835(out)X +2 f +933(sdbm)X +1 f +1068(,)X +1100(and)X +1208(convert)X +1415(some)X +1566(databases.)X + +3 p +%%Page: 3 3 +8 s 0 xH 0 xS 1 f +10 s +2216 384(-)N +2263(3)X +2323(-)X +555 672(NULLs)N +821(in)X +903(the)X +1021(key)X +1157(and)X +1293(data)X +1447(\256elds,)X +1660(thus)X +1813(is)X +1886(unsuitable)X +2235(to)X +2317(convert)X +2578(some)X +2767(peculiar)X +3046(databases)X +3374(that)X +3514(insist)X +3702(in)X +3784(includ-)X +555 768(ing)N +677(the)X +795(terminating)X +1184(null.)X +755 892(I)N +841(have)X +1052(also)X +1240(included)X +1575(a)X +1670(copy)X +1885(of)X +2011(the)X +7 f +2195(dbe)X +1 f +2397(\()X +2 f +2424(ndbm)X +1 f +2660(DataBase)X +3026(Editor\))X +3311(by)X +3449(Janick)X +3712(Bergeron)X +555 988([janick@bnr.ca])N +1098(for)X +1212(your)X +1379(pleasure.)X +1687(You)X +1845(may)X +2003(\256nd)X +2147(it)X +2211(more)X +2396(useful)X +2612(than)X +2770(the)X +2888(little)X +7 f +3082(dbu)X +1 f +3246(utility.)X +7 f +755 1112(dbm.[ch])N +1 f +1169(is)X +1252(a)X +2 f +1318(dbm)X +1 f +1486(library)X +1730(emulation)X +2079(on)X +2188(top)X +2319(of)X +2 f +2415(ndbm)X +1 f +2622(\(and)X +2794(hence)X +3011(suitable)X +3289(for)X +2 f +3412(sdbm)X +1 f +3581(\).)X +3657(Written)X +3931(by)X +555 1208(Robert)N +793(Elz.)X +755 1332(The)N +2 f +901(sdbm)X +1 f +1090(library)X +1324(has)X +1451(been)X +1623(around)X +1866(in)X +1948(beta)X +2102(test)X +2233(for)X +2347(quite)X +2527(a)X +2583(long)X +2745(time,)X +2927(and)X +3063(from)X +3239(whatever)X +3554(little)X +3720(feedback)X +555 1428(I)N +609(received)X +909(\(maybe)X +1177(no)X +1284(news)X +1476(is)X +1555(good)X +1741(news\),)X +1979(I)X +2032(believe)X +2290(it)X +2360(has)X +2493(been)X +2671(functioning)X +3066(without)X +3336(any)X +3478(signi\256cant)X +3837(prob-)X +555 1524(lems.)N +752(I)X +805(would,)X +1051(of)X +1144(course,)X +1400(appreciate)X +1757(all)X +1863(\256xes)X +2040(and/or)X +2271(improvements.)X +2774(Portability)X +3136(enhancements)X +3616(would)X +3841(espe-)X +555 1620(cially)N +753(be)X +849(useful.)X +3 f +555 1812(Implementation)N +1122(Issues)X +1 f +755 1936(Hash)N +944(functions:)X +1288(The)X +1437(algorithm)X +1772(behind)X +2 f +2014(sdbm)X +1 f +2207(implementation)X +2733(needs)X +2939(a)X +2998(good)X +3181(bit-scrambling)X +3671(hash)X +3841(func-)X +555 2032(tion)N +702(to)X +787(be)X +886(effective.)X +1211(I)X +1261(ran)X +1387(into)X +1534(a)X +1593(set)X +1705(of)X +1795(constants)X +2116(for)X +2233(a)X +2292(simple)X +2528(hash)X +2698(function)X +2988(that)X +3130(seem)X +3317(to)X +3401(help)X +2 f +3561(sdbm)X +1 f +3752(perform)X +555 2128(better)N +758(than)X +2 f +916(ndbm)X +1 f +1114(for)X +1228(various)X +1484(inputs:)X +7 f +747 2272(/*)N +795 2368(*)N +891(polynomial)X +1419(conversion)X +1947(ignoring)X +2379(overflows)X +795 2464(*)N +891(65599)X +1179(nice.)X +1467(65587)X +1755(even)X +1995(better.)X +795 2560(*/)N +747 2656(long)N +747 2752(dbm_hash\(char)N +1419(*str,)X +1707(int)X +1899(len\))X +2139({)X +939 2848(register)N +1371(unsigned)X +1803(long)X +2043(n)X +2139(=)X +2235(0;)X +939 3040(while)N +1227(\(len--\))X +1131 3136(n)N +1227(=)X +1323(n)X +1419(*)X +1515(65599)X +1803(+)X +1899(*str++;)X +939 3232(return)N +1275(n;)X +747 3328(})N +1 f +755 3500(There)N +975(may)X +1145(be)X +1253(better)X +1467(hash)X +1645(functions)X +1974(for)X +2099(the)X +2228(purposes)X +2544(of)X +2642(dynamic)X +2949(hashing.)X +3269(Try)X +3416(your)X +3594(favorite,)X +3895(and)X +555 3596(check)N +766(the)X +887(page\256le.)X +1184(If)X +1261(it)X +1328(contains)X +1618(too)X +1743(many)X +1944(pages)X +2150(with)X +2315(too)X +2440(many)X +2641(holes,)X +2853(\(in)X +2965(relation)X +3233(to)X +3318(this)X +3456(one)X +3595(for)X +3712(example\))X +555 3692(or)N +656(if)X +2 f +739(sdbm)X +1 f +942(simply)X +1193(stops)X +1391(working)X +1692(\(fails)X +1891(after)X +7 f +2101(SPLTMAX)X +1 f +2471(attempts)X +2776(to)X +2872(split\))X +3070(when)X +3278(you)X +3432(feed)X +3604(your)X +3784(NEWS)X +7 f +555 3788(history)N +1 f +912(\256le)X +1035(to)X +1118(it,)X +1203(you)X +1344(probably)X +1650(do)X +1751(not)X +1874(have)X +2047(a)X +2104(good)X +2285(hashing)X +2555(function.)X +2883(If)X +2958(you)X +3099(do)X +3200(better)X +3404(\(for)X +3545(different)X +3842(types)X +555 3884(of)N +642(input\),)X +873(I)X +920(would)X +1140(like)X +1280(to)X +1362(know)X +1560(about)X +1758(the)X +1876(function)X +2163(you)X +2303(use.)X +755 4008(Block)N +967(sizes:)X +1166(It)X +1236(seems)X +1453(\(from)X +1657(various)X +1914(tests)X +2077(on)X +2178(a)X +2235(few)X +2377(machines\))X +2727(that)X +2867(a)X +2923(page)X +3095(\256le)X +3217(block)X +3415(size)X +7 f +3588(PBLKSIZ)X +1 f +3944(of)X +555 4104(1024)N +738(is)X +814(by)X +917(far)X +1030(the)X +1150(best)X +1301(for)X +1417(performance,)X +1866(but)X +1990(this)X +2127(also)X +2278(happens)X +2563(to)X +2647(limit)X +2819(the)X +2939(size)X +3086(of)X +3175(a)X +3233(key/value)X +3567(pair.)X +3734(Depend-)X +555 4200(ing)N +681(on)X +785(your)X +956(needs,)X +1183(you)X +1327(may)X +1489(wish)X +1663(to)X +1748(increase)X +2035(the)X +2156(page)X +2331(size,)X +2499(and)X +2638(also)X +2790(adjust)X +7 f +3032(PAIRMAX)X +1 f +3391(\(the)X +3539(maximum)X +3886(size)X +555 4296(of)N +648(a)X +710(key/value)X +1048(pair)X +1199(allowed:)X +1501(should)X +1740(always)X +1989(be)X +2090(at)X +2173(least)X +2345(three)X +2531(words)X +2752(smaller)X +3013(than)X +7 f +3204(PBLKSIZ)X +1 f +(.\))S +3612(accordingly.)X +555 4392(The)N +706(system-wide)X +1137(version)X +1399(of)X +1492(the)X +1616(library)X +1856(should)X +2095(probably)X +2406(be)X +2508(con\256gured)X +2877(with)X +3044(1024)X +3229(\(distribution)X +3649(default\),)X +3944(as)X +555 4488(this)N +690(appears)X +956(to)X +1038(be)X +1134(suf\256cient)X +1452(for)X +1566(most)X +1741(common)X +2041(uses)X +2199(of)X +2 f +2286(sdbm)X +1 f +2455(.)X +3 f +555 4680(Portability)N +1 f +755 4804(This)N +917(package)X +1201(has)X +1328(been)X +1500(tested)X +1707(in)X +1789(many)X +1987(different)X +2284(UN*Xes)X +2585(even)X +2757(including)X +3079(minix,)X +3305(and)X +3441(appears)X +3707(to)X +3789(be)X +3885(rea-)X +555 4900(sonably)N +824(portable.)X +1127(This)X +1289(does)X +1456(not)X +1578(mean)X +1772(it)X +1836(will)X +1980(port)X +2129(easily)X +2336(to)X +2418(non-UN*X)X +2799(systems.)X +3 f +555 5092(Notes)N +767(and)X +915(Miscellaneous)X +1 f +755 5216(The)N +2 f +913(sdbm)X +1 f +1115(is)X +1201(not)X +1336(a)X +1405(very)X +1581(complicated)X +2006(package,)X +2323(at)X +2414(least)X +2594(not)X +2729(after)X +2910(you)X +3063(familiarize)X +3444(yourself)X +3739(with)X +3913(the)X +555 5312(literature)N +879(on)X +993(external)X +1286(hashing.)X +1589(There)X +1811(are)X +1944(other)X +2143(interesting)X +2514(algorithms)X +2889(in)X +2984(existence)X +3316(that)X +3469(ensure)X +3712(\(approxi-)X +555 5408(mately\))N +825(single-read)X +1207(access)X +1438(to)X +1525(a)X +1586(data)X +1745(value)X +1944(associated)X +2299(with)X +2466(any)X +2607(key.)X +2768(These)X +2984(are)X +3107(directory-less)X +3568(schemes)X +3864(such)X +555 5504(as)N +2 f +644(linear)X +857(hashing)X +1 f +1132([Lit80])X +1381(\(+)X +1475(Larson)X +1720(variations\),)X +2 f +2105(spiral)X +2313(storage)X +1 f +2575([Mar79])X +2865(or)X +2954(directory)X +3265(schemes)X +3558(such)X +3726(as)X +2 f +3814(exten-)X +555 5600(sible)N +731(hashing)X +1 f +1009([Fag79])X +1288(by)X +1393(Fagin)X +1600(et)X +1683(al.)X +1786(I)X +1838(do)X +1943(hope)X +2124(these)X +2314(sources)X +2579(provide)X +2848(a)X +2908(reasonable)X +3276(playground)X +3665(for)X +3783(experi-)X +555 5696(mentation)N +907(with)X +1081(other)X +1277(algorithms.)X +1690(See)X +1837(the)X +1966(June)X +2144(1988)X +2335(issue)X +2526(of)X +2624(ACM)X +2837(Computing)X +3227(Surveys)X +3516([Enb88])X +3810(for)X +3935(an)X +555 5792(excellent)N +865(overview)X +1184(of)X +1271(the)X +1389(\256eld.)X + +4 p +%%Page: 4 4 +10 s 0 xH 0 xS 1 f +2216 384(-)N +2263(4)X +2323(-)X +3 f +555 672(References)N +1 f +555 824([Lar78])N +875(P.-A.)X +1064(Larson,)X +1327(``Dynamic)X +1695(Hashing'',)X +2 f +2056(BIT)X +1 f +(,)S +2216(vol.)X +2378(18,)X +2518(pp.)X +2638(184-201,)X +2945(1978.)X +555 948([Tho90])N +875(Ken)X +1029(Thompson,)X +2 f +1411(private)X +1658(communication)X +1 f +2152(,)X +2192(Nov.)X +2370(1990)X +555 1072([Lit80])N +875(W.)X +992(Litwin,)X +1246(``)X +1321(Linear)X +1552(Hashing:)X +1862(A)X +1941(new)X +2096(tool)X +2261(for)X +2396(\256le)X +2539(and)X +2675(table)X +2851(addressing'',)X +2 f +3288(Proceedings)X +3709(of)X +3791(the)X +3909(6th)X +875 1168(Conference)N +1269(on)X +1373(Very)X +1548(Large)X +1782(Dabatases)X +2163(\(Montreal\))X +1 f +2515(,)X +2558(pp.)X +2701(212-223,)X +3031(Very)X +3215(Large)X +3426(Database)X +3744(Founda-)X +875 1264(tion,)N +1039(Saratoga,)X +1360(Calif.,)X +1580(1980.)X +555 1388([Fag79])N +875(R.)X +969(Fagin,)X +1192(J.)X +1284(Nievergelt,)X +1684(N.)X +1803(Pippinger,)X +2175(and)X +2332(H.)X +2451(R.)X +2544(Strong,)X +2797(``Extendible)X +3218(Hashing)X +3505(-)X +3552(A)X +3630(Fast)X +3783(Access)X +875 1484(Method)N +1144(for)X +1258(Dynamic)X +1572(Files'',)X +2 f +1821(ACM)X +2010(Trans.)X +2236(Database)X +2563(Syst.)X +1 f +2712(,)X +2752(vol.)X +2894(4,)X +2994(no.3,)X +3174(pp.)X +3294(315-344,)X +3601(Sept.)X +3783(1979.)X +555 1608([Wal84])N +875(Rich)X +1055(Wales,)X +1305(``Discussion)X +1739(of)X +1835("dbm")X +2072(data)X +2235(base)X +2406(system'',)X +2 f +2730(USENET)X +3051(newsgroup)X +3430(unix.wizards)X +1 f +3836(,)X +3884(Jan.)X +875 1704(1984.)N +555 1828([Tor87])N +875(Chris)X +1068(Torek,)X +1300(``Re:)X +1505(dbm.a)X +1743(and)X +1899(ndbm.a)X +2177(archives'',)X +2 f +2539(USENET)X +2852(newsgroup)X +3223(comp.unix)X +1 f +3555(,)X +3595(1987.)X +555 1952([Mar79])N +875(G.)X +974(N.)X +1073(Martin,)X +1332(``Spiral)X +1598(Storage:)X +1885(Incrementally)X +2371(Augmentable)X +2843(Hash)X +3048(Addressed)X +3427(Storage'',)X +2 f +3766(Techni-)X +875 2048(cal)N +993(Report)X +1231(#27)X +1 f +(,)S +1391(University)X +1749(of)X +1836(Varwick,)X +2153(Coventry,)X +2491(U.K.,)X +2687(1979.)X +555 2172([Enb88])N +875(R.)X +977(J.)X +1057(Enbody)X +1335(and)X +1480(H.)X +1586(C.)X +1687(Du,)X +1833(``Dynamic)X +2209(Hashing)X +2524(Schemes'',)X +2 f +2883(ACM)X +3080(Computing)X +3463(Surveys)X +1 f +3713(,)X +3761(vol.)X +3911(20,)X +875 2268(no.)N +995(2,)X +1075(pp.)X +1195(85-113,)X +1462(June)X +1629(1988.)X + +4 p +%%Trailer +xt + +xs diff --git a/ext/dbm/sdbm/sdbm.3 b/ext/dbm/sdbm/sdbm.3 new file mode 100644 index 0000000000..f0f2d07c84 --- /dev/null +++ b/ext/dbm/sdbm/sdbm.3 @@ -0,0 +1,290 @@ +.\" $Id: sdbm.3,v 1.2 90/12/13 13:00:57 oz Exp $ +.TH SDBM 3 "1 March 1990" +.SH NAME +sdbm, dbm_open, dbm_prep, dbm_close, dbm_fetch, dbm_store, dbm_delete, dbm_firstkey, dbm_nextkey, dbm_hash, dbm_rdonly, dbm_error, dbm_clearerr, dbm_dirfno, dbm_pagfno \- data base subroutines +.SH SYNOPSIS +.nf +.ft B +#include <sdbm.h> +.sp +typedef struct { + char *dptr; + int dsize; +} datum; +.sp +datum nullitem = { NULL, 0 }; +.sp +\s-1DBM\s0 *dbm_open(char *file, int flags, int mode) +.sp +\s-1DBM\s0 *dbm_prep(char *dirname, char *pagname, int flags, int mode) +.sp +void dbm_close(\s-1DBM\s0 *db) +.sp +datum dbm_fetch(\s-1DBM\s0 *db, key) +.sp +int dbm_store(\s-1DBM\s0 *db, datum key, datum val, int flags) +.sp +int dbm_delete(\s-1DBM\s0 *db, datum key) +.sp +datum dbm_firstkey(\s-1DBM\s0 *db) +.sp +datum dbm_nextkey(\s-1DBM\s0 *db) +.sp +long dbm_hash(char *string, int len) +.sp +int dbm_rdonly(\s-1DBM\s0 *db) +int dbm_error(\s-1DBM\s0 *db) +dbm_clearerr(\s-1DBM\s0 *db) +int dbm_dirfno(\s-1DBM\s0 *db) +int dbm_pagfno(\s-1DBM\s0 *db) +.ft R +.fi +.SH DESCRIPTION +.IX "database library" sdbm "" "\fLsdbm\fR" +.IX dbm_open "" "\fLdbm_open\fR \(em open \fLsdbm\fR database" +.IX dbm_prep "" "\fLdbm_prep\fR \(em prepare \fLsdbm\fR database" +.IX dbm_close "" "\fLdbm_close\fR \(em close \fLsdbm\fR routine" +.IX dbm_fetch "" "\fLdbm_fetch\fR \(em fetch \fLsdbm\fR database data" +.IX dbm_store "" "\fLdbm_store\fR \(em add data to \fLsdbm\fR database" +.IX dbm_delete "" "\fLdbm_delete\fR \(em remove data from \fLsdbm\fR database" +.IX dbm_firstkey "" "\fLdbm_firstkey\fR \(em access \fLsdbm\fR database" +.IX dbm_nextkey "" "\fLdbm_nextkey\fR \(em access \fLsdbm\fR database" +.IX dbm_hash "" "\fLdbm_hash\fR \(em string hash for \fLsdbm\fR database" +.IX dbm_rdonly "" "\fLdbm_rdonly\fR \(em return \fLsdbm\fR database read-only mode" +.IX dbm_error "" "\fLdbm_error\fR \(em return \fLsdbm\fR database error condition" +.IX dbm_clearerr "" "\fLdbm_clearerr\fR \(em clear \fLsdbm\fR database error condition" +.IX dbm_dirfno "" "\fLdbm_dirfno\fR \(em return \fLsdbm\fR database bitmap file descriptor" +.IX dbm_pagfno "" "\fLdbm_pagfno\fR \(em return \fLsdbm\fR database data file descriptor" +.IX "database functions \(em \fLsdbm\fR" dbm_open "" \fLdbm_open\fP +.IX "database functions \(em \fLsdbm\fR" dbm_prep "" \fLdbm_prep\fP +.IX "database functions \(em \fLsdbm\fR" dbm_close "" \fLdbm_close\fP +.IX "database functions \(em \fLsdbm\fR" dbm_fetch "" \fLdbm_fetch\fP +.IX "database functions \(em \fLsdbm\fR" dbm_store "" \fLdbm_store\fP +.IX "database functions \(em \fLsdbm\fR" dbm_delete "" \fLdbm_delete\fP +.IX "database functions \(em \fLsdbm\fR" dbm_firstkey "" \fLdbm_firstkey\fP +.IX "database functions \(em \fLsdbm\fR" dbm_nextkey "" \fLdbm_nextkey\fP +.IX "database functions \(em \fLsdbm\fR" dbm_rdonly "" \fLdbm_rdonly\fP +.IX "database functions \(em \fLsdbm\fR" dbm_error "" \fLdbm_error\fP +.IX "database functions \(em \fLsdbm\fR" dbm_clearerr "" \fLdbm_clearerr\fP +.IX "database functions \(em \fLsdbm\fR" dbm_dirfno "" \fLdbm_dirfno\fP +.IX "database functions \(em \fLsdbm\fR" dbm_pagfno "" \fLdbm_pagfno\fP +.LP +This package allows an application to maintain a mapping of <key,value> pairs +in disk files. This is not to be considered a real database system, but is +still useful in many simple applications built around fast retrieval of a data +value from a key. This implementation uses an external hashing scheme, +called Dynamic Hashing, as described by Per-Aake Larson in BIT 18 (1978) pp. +184-201. Retrieval of any item usually requires a single disk access. +The application interface is compatible with the +.IR ndbm (3) +library. +.LP +An +.B sdbm +database is kept in two files usually given the extensions +.B \.dir +and +.BR \.pag . +The +.B \.dir +file contains a bitmap representing a forest of binary hash trees, the leaves +of which indicate data pages in the +.B \.pag +file. +.LP +The application interface uses the +.B datum +structure to describe both +.I keys +and +.IR value s. +A +.B datum +specifies a byte sequence of +.I dsize +size pointed to by +.IR dptr . +If you use +.SM ASCII +strings as +.IR key s +or +.IR value s, +then you must decide whether or not to include the terminating +.SM NUL +byte which sometimes defines strings. Including it will require larger +database files, but it will be possible to get sensible output from a +.IR strings (1) +command applied to the data file. +.LP +In order to allow a process using this package to manipulate multiple +databases, the applications interface always requires a +.IR handle , +a +.BR "DBM *" , +to identify the database to be manipulated. Such a handle can be obtained +from the only routines that do not require it, namely +.BR dbm_open (\|) +or +.BR dbm_prep (\|). +Either of these will open or create the two necessary files. The +difference is that the latter allows explicitly naming the bitmap and data +files whereas +.BR dbm_open (\|) +will take a base file name and call +.BR dbm_prep (\|) +with the default extensions. +The +.I flags +and +.I mode +parameters are the same as for +.BR open (2). +.LP +To free the resources occupied while a database handle is active, call +.BR dbm_close (\|). +.LP +Given a handle, one can retrieve data associated with a key by using the +.BR dbm_fetch (\|) +routine, and associate data with a key by using the +.BR dbm_store (\|) +routine. +.LP +The values of the +.I flags +parameter for +.BR dbm_store (\|) +can be either +.BR \s-1DBM_INSERT\s0 , +which will not change an existing entry with the same key, or +.BR \s-1DBM_REPLACE\s0 , +which will replace an existing entry with the same key. +Keys are unique within the database. +.LP +To delete a key and its associated value use the +.BR dbm_delete (\|) +routine. +.LP +To retrieve every key in the database, use a loop like: +.sp +.nf +.ft B +for (key = dbm_firstkey(db); key.dptr != NULL; key = dbm_nextkey(db)) + ; +.ft R +.fi +.LP +The order of retrieval is unspecified. +.LP +If you determine that the performance of the database is inadequate or +you notice clustering or other effects that may be due to the hashing +algorithm used by this package, you can override it by supplying your +own +.BR dbm_hash (\|) +routine. Doing so will make the database unintelligable to any other +applications that do not use your specialized hash function. +.sp +.LP +The following macros are defined in the header file: +.IP +.BR dbm_rdonly (\|) +returns true if the database has been opened read\-only. +.IP +.BR dbm_error (\|) +returns true if an I/O error has occurred. +.IP +.BR dbm_clearerr (\|) +allows you to clear the error flag if you think you know what the error +was and insist on ignoring it. +.IP +.BR dbm_dirfno (\|) +returns the file descriptor associated with the bitmap file. +.IP +.BR dbm_pagfno (\|) +returns the file descriptor associated with the data file. +.SH SEE ALSO +.IR open (2). +.SH DIAGNOSTICS +Functions that return a +.B "DBM *" +handle will use +.SM NULL +to indicate an error. +Functions that return an +.B int +will use \-1 to indicate an error. The normal return value in that case is 0. +Functions that return a +.B datum +will return +.B nullitem +to indicate an error. +.LP +As a special case of +.BR dbm_store (\|), +if it is called with the +.B \s-1DBM_INSERT\s0 +flag and the key already exists in the database, the return value will be 1. +.LP +In general, if a function parameter is invalid, +.B errno +will be set to +.BR \s-1EINVAL\s0 . +If a write operation is requested on a read-only database, +.B errno +will be set to +.BR \s-1ENOPERM\s0 . +If a memory allocation (using +.IR malloc (3)) +failed, +.B errno +will be set to +.BR \s-1ENOMEM\s0 . +For I/O operation failures +.B errno +will contain the value set by the relevant failed system call, either +.IR read (2), +.IR write (2), +or +.IR lseek (2). +.SH AUTHOR +.IP "Ozan S. Yigit" (oz@nexus.yorku.ca) +.SH BUGS +The sum of key and value data sizes must not exceed +.B \s-1PAIRMAX\s0 +(1008 bytes). +.LP +The sum of the key and value data sizes where several keys hash to the +same value must fit within one bitmap page. +.LP +The +.B \.pag +file will contain holes, so its apparent size is larger than its contents. +When copied through the filesystem the holes will be filled. +.LP +The contents of +.B datum +values returned are in volatile storage. If you want to retain the values +pointed to, you must copy them immediately before another call to this package. +.LP +The only safe way for multiple processes to (read and) update a database at +the same time, is to implement a private locking scheme outside this package +and open and close the database between lock acquisitions. It is safe for +multiple processes to concurrently access a database read-only. +.SH APPLICATIONS PORTABILITY +For complete source code compatibility with the Berkeley Unix +.IR ndbm (3) +library, the +.B sdbm.h +header file should be installed in +.BR /usr/include/ndbm.h . +.LP +The +.B nullitem +data item, and the +.BR dbm_prep (\|), +.BR dbm_hash (\|), +.BR dbm_rdonly (\|), +.BR dbm_dirfno (\|), +and +.BR dbm_pagfno (\|) +functions are unique to this package. diff --git a/ext/dbm/sdbm/sdbm.c b/ext/dbm/sdbm/sdbm.c new file mode 100644 index 0000000000..d4ecdceb07 --- /dev/null +++ b/ext/dbm/sdbm/sdbm.c @@ -0,0 +1,524 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. + * + * core routines + */ + +#ifndef lint +static char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $"; +#endif + +#include "sdbm.h" +#include "tune.h" +#include "pair.h" + +#include <sys/types.h> +#include <sys/stat.h> +#ifdef BSD42 +#include <sys/file.h> +#else +#include <fcntl.h> +#include <memory.h> +#endif +#include <errno.h> +#include <string.h> + +#ifdef __STDC__ +#include <stddef.h> +#endif + +#ifndef NULL +#define NULL 0 +#endif + +/* + * externals + */ +#ifndef sun +extern int errno; +#endif + +extern char *malloc proto((unsigned int)); +extern void free proto((void *)); +extern long lseek(); + +/* + * forward + */ +static int getdbit proto((DBM *, long)); +static int setdbit proto((DBM *, long)); +static int getpage proto((DBM *, long)); +static datum getnext proto((DBM *)); +static int makroom proto((DBM *, long, int)); + +/* + * useful macros + */ +#define bad(x) ((x).dptr == NULL || (x).dsize < 0) +#define exhash(item) sdbm_hash((item).dptr, (item).dsize) +#define ioerr(db) ((db)->flags |= DBM_IOERR) + +#define OFF_PAG(off) (long) (off) * PBLKSIZ +#define OFF_DIR(off) (long) (off) * DBLKSIZ + +static long masks[] = { + 000000000000, 000000000001, 000000000003, 000000000007, + 000000000017, 000000000037, 000000000077, 000000000177, + 000000000377, 000000000777, 000000001777, 000000003777, + 000000007777, 000000017777, 000000037777, 000000077777, + 000000177777, 000000377777, 000000777777, 000001777777, + 000003777777, 000007777777, 000017777777, 000037777777, + 000077777777, 000177777777, 000377777777, 000777777777, + 001777777777, 003777777777, 007777777777, 017777777777 +}; + +datum nullitem = {NULL, 0}; + +DBM * +sdbm_open(file, flags, mode) +register char *file; +register int flags; +register int mode; +{ + register DBM *db; + register char *dirname; + register char *pagname; + register int n; + + if (file == NULL || !*file) + return errno = EINVAL, (DBM *) NULL; +/* + * need space for two seperate filenames + */ + n = strlen(file) * 2 + strlen(DIRFEXT) + strlen(PAGFEXT) + 2; + + if ((dirname = malloc((unsigned) n)) == NULL) + return errno = ENOMEM, (DBM *) NULL; +/* + * build the file names + */ + dirname = strcat(strcpy(dirname, file), DIRFEXT); + pagname = strcpy(dirname + strlen(dirname) + 1, file); + pagname = strcat(pagname, PAGFEXT); + + db = sdbm_prep(dirname, pagname, flags, mode); + free((char *) dirname); + return db; +} + +DBM * +sdbm_prep(dirname, pagname, flags, mode) +char *dirname; +char *pagname; +int flags; +int mode; +{ + register DBM *db; + struct stat dstat; + + if ((db = (DBM *) malloc(sizeof(DBM))) == NULL) + return errno = ENOMEM, (DBM *) NULL; + + db->flags = 0; + db->hmask = 0; + db->blkptr = 0; + db->keyptr = 0; +/* + * adjust user flags so that WRONLY becomes RDWR, + * as required by this package. Also set our internal + * flag for RDONLY if needed. + */ + if (flags & O_WRONLY) + flags = (flags & ~O_WRONLY) | O_RDWR; + + else if ((flags & 03) == O_RDONLY) + db->flags = DBM_RDONLY; +/* + * open the files in sequence, and stat the dirfile. + * If we fail anywhere, undo everything, return NULL. + */ + if ((db->pagf = open(pagname, flags, mode)) > -1) { + if ((db->dirf = open(dirname, flags, mode)) > -1) { +/* + * need the dirfile size to establish max bit number. + */ + if (fstat(db->dirf, &dstat) == 0) { +/* + * zero size: either a fresh database, or one with a single, + * unsplit data page: dirpage is all zeros. + */ + db->dirbno = (!dstat.st_size) ? 0 : -1; + db->pagbno = -1; + db->maxbno = dstat.st_size * BYTESIZ; + + (void) memset(db->pagbuf, 0, PBLKSIZ); + (void) memset(db->dirbuf, 0, DBLKSIZ); + /* + * success + */ + return db; + } + (void) close(db->dirf); + } + (void) close(db->pagf); + } + free((char *) db); + return (DBM *) NULL; +} + +void +sdbm_close(db) +register DBM *db; +{ + if (db == NULL) + errno = EINVAL; + else { + (void) close(db->dirf); + (void) close(db->pagf); + free((char *) db); + } +} + +datum +sdbm_fetch(db, key) +register DBM *db; +datum key; +{ + if (db == NULL || bad(key)) + return errno = EINVAL, nullitem; + + if (getpage(db, exhash(key))) + return getpair(db->pagbuf, key); + + return ioerr(db), nullitem; +} + +int +sdbm_delete(db, key) +register DBM *db; +datum key; +{ + if (db == NULL || bad(key)) + return errno = EINVAL, -1; + if (sdbm_rdonly(db)) + return errno = EPERM, -1; + + if (getpage(db, exhash(key))) { + if (!delpair(db->pagbuf, key)) + return -1; +/* + * update the page file + */ + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return ioerr(db), -1; + + return 0; + } + + return ioerr(db), -1; +} + +int +sdbm_store(db, key, val, flags) +register DBM *db; +datum key; +datum val; +int flags; +{ + int need; + register long hash; + + if (db == NULL || bad(key)) + return errno = EINVAL, -1; + if (sdbm_rdonly(db)) + return errno = EPERM, -1; + + need = key.dsize + val.dsize; +/* + * is the pair too big (or too small) for this database ?? + */ + if (need < 0 || need > PAIRMAX) + return errno = EINVAL, -1; + + if (getpage(db, (hash = exhash(key)))) { +/* + * if we need to replace, delete the key/data pair + * first. If it is not there, ignore. + */ + if (flags == DBM_REPLACE) + (void) delpair(db->pagbuf, key); +#ifdef SEEDUPS + else if (duppair(db->pagbuf, key)) + return 1; +#endif +/* + * if we do not have enough room, we have to split. + */ + if (!fitpair(db->pagbuf, need)) + if (!makroom(db, hash, need)) + return ioerr(db), -1; +/* + * we have enough room or split is successful. insert the key, + * and update the page file. + */ + (void) putpair(db->pagbuf, key, val); + + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return ioerr(db), -1; + /* + * success + */ + return 0; + } + + return ioerr(db), -1; +} + +/* + * makroom - make room by splitting the overfull page + * this routine will attempt to make room for SPLTMAX times before + * giving up. + */ +static int +makroom(db, hash, need) +register DBM *db; +long hash; +int need; +{ + long newp; + char twin[PBLKSIZ]; + char *pag = db->pagbuf; + char *new = twin; + register int smax = SPLTMAX; + + do { +/* + * split the current page + */ + (void) splpage(pag, new, db->hmask + 1); +/* + * address of the new page + */ + newp = (hash & db->hmask) | (db->hmask + 1); + +/* + * write delay, read avoidence/cache shuffle: + * select the page for incoming pair: if key is to go to the new page, + * write out the previous one, and copy the new one over, thus making + * it the current page. If not, simply write the new page, and we are + * still looking at the page of interest. current page is not updated + * here, as sdbm_store will do so, after it inserts the incoming pair. + */ + if (hash & (db->hmask + 1)) { + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return 0; + db->pagbno = newp; + (void) memcpy(pag, new, PBLKSIZ); + } + else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0 + || write(db->pagf, new, PBLKSIZ) < 0) + return 0; + + if (!setdbit(db, db->curbit)) + return 0; +/* + * see if we have enough room now + */ + if (fitpair(pag, need)) + return 1; +/* + * try again... update curbit and hmask as getpage would have + * done. because of our update of the current page, we do not + * need to read in anything. BUT we have to write the current + * [deferred] page out, as the window of failure is too great. + */ + db->curbit = 2 * db->curbit + + ((hash & (db->hmask + 1)) ? 2 : 1); + db->hmask |= db->hmask + 1; + + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return 0; + + } while (--smax); +/* + * if we are here, this is real bad news. After SPLTMAX splits, + * we still cannot fit the key. say goodnight. + */ +#ifdef BADMESS + (void) write(2, "sdbm: cannot insert after SPLTMAX attempts.\n", 44); +#endif + return 0; + +} + +/* + * the following two routines will break if + * deletions aren't taken into account. (ndbm bug) + */ +datum +sdbm_firstkey(db) +register DBM *db; +{ + if (db == NULL) + return errno = EINVAL, nullitem; +/* + * start at page 0 + */ + if (lseek(db->pagf, OFF_PAG(0), SEEK_SET) < 0 + || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return ioerr(db), nullitem; + db->pagbno = 0; + db->blkptr = 0; + db->keyptr = 0; + + return getnext(db); +} + +datum +sdbm_nextkey(db) +register DBM *db; +{ + if (db == NULL) + return errno = EINVAL, nullitem; + return getnext(db); +} + +/* + * all important binary trie traversal + */ +static int +getpage(db, hash) +register DBM *db; +register long hash; +{ + register int hbit; + register long dbit; + register long pagb; + + dbit = 0; + hbit = 0; + while (dbit < db->maxbno && getdbit(db, dbit)) + dbit = 2 * dbit + ((hash & (1 << hbit++)) ? 2 : 1); + + debug(("dbit: %d...", dbit)); + + db->curbit = dbit; + db->hmask = masks[hbit]; + + pagb = hash & db->hmask; +/* + * see if the block we need is already in memory. + * note: this lookaside cache has about 10% hit rate. + */ + if (pagb != db->pagbno) { +/* + * note: here, we assume a "hole" is read as 0s. + * if not, must zero pagbuf first. + */ + if (lseek(db->pagf, OFF_PAG(pagb), SEEK_SET) < 0 + || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return 0; + if (!chkpage(db->pagbuf)) + return 0; + db->pagbno = pagb; + + debug(("pag read: %d\n", pagb)); + } + return 1; +} + +static int +getdbit(db, dbit) +register DBM *db; +register long dbit; +{ + register long c; + register long dirb; + + c = dbit / BYTESIZ; + dirb = c / DBLKSIZ; + + if (dirb != db->dirbno) { + if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 + || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) + return 0; + db->dirbno = dirb; + + debug(("dir read: %d\n", dirb)); + } + + return db->dirbuf[c % DBLKSIZ] & (1 << dbit % BYTESIZ); +} + +static int +setdbit(db, dbit) +register DBM *db; +register long dbit; +{ + register long c; + register long dirb; + + c = dbit / BYTESIZ; + dirb = c / DBLKSIZ; + + if (dirb != db->dirbno) { + if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 + || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) + return 0; + db->dirbno = dirb; + + debug(("dir read: %d\n", dirb)); + } + + db->dirbuf[c % DBLKSIZ] |= (1 << dbit % BYTESIZ); + + if (dbit >= db->maxbno) + db->maxbno += DBLKSIZ * BYTESIZ; + + if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 + || write(db->dirf, db->dirbuf, DBLKSIZ) < 0) + return 0; + + return 1; +} + +/* + * getnext - get the next key in the page, and if done with + * the page, try the next page in sequence + */ +static datum +getnext(db) +register DBM *db; +{ + datum key; + + for (;;) { + db->keyptr++; + key = getnkey(db->pagbuf, db->keyptr); + if (key.dptr != NULL) + return key; +/* + * we either run out, or there is nothing on this page.. + * try the next one... If we lost our position on the + * file, we will have to seek. + */ + db->keyptr = 0; + if (db->pagbno != db->blkptr++) + if (lseek(db->pagf, OFF_PAG(db->blkptr), SEEK_SET) < 0) + break; + db->pagbno = db->blkptr; + if (read(db->pagf, db->pagbuf, PBLKSIZ) <= 0) + break; + if (!chkpage(db->pagbuf)) + break; + } + + return ioerr(db), nullitem; +} diff --git a/ext/dbm/sdbm/sdbm.h b/ext/dbm/sdbm/sdbm.h new file mode 100644 index 0000000000..e2fc762aab --- /dev/null +++ b/ext/dbm/sdbm/sdbm.h @@ -0,0 +1,91 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Ake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. + */ +#define DBLKSIZ 4096 +#define PBLKSIZ 1024 +#define PAIRMAX 1008 /* arbitrary on PBLKSIZ-N */ +#define SPLTMAX 10 /* maximum allowed splits */ + /* for a single insertion */ +#define DIRFEXT ".dir" +#define PAGFEXT ".pag" + +typedef struct { + int dirf; /* directory file descriptor */ + int pagf; /* page file descriptor */ + int flags; /* status/error flags, see below */ + long maxbno; /* size of dirfile in bits */ + long curbit; /* current bit number */ + long hmask; /* current hash mask */ + long blkptr; /* current block for nextkey */ + int keyptr; /* current key for nextkey */ + long blkno; /* current page to read/write */ + long pagbno; /* current page in pagbuf */ + char pagbuf[PBLKSIZ]; /* page file block buffer */ + long dirbno; /* current block in dirbuf */ + char dirbuf[DBLKSIZ]; /* directory file block buffer */ +} DBM; + +#define DBM_RDONLY 0x1 /* data base open read-only */ +#define DBM_IOERR 0x2 /* data base I/O error */ + +/* + * utility macros + */ +#define sdbm_rdonly(db) ((db)->flags & DBM_RDONLY) +#define sdbm_error(db) ((db)->flags & DBM_IOERR) + +#define sdbm_clearerr(db) ((db)->flags &= ~DBM_IOERR) /* ouch */ + +#define sdbm_dirfno(db) ((db)->dirf) +#define sdbm_pagfno(db) ((db)->pagf) + +typedef struct { + char *dptr; + int dsize; +} datum; + +extern datum nullitem; + +#ifdef __STDC__ +#define proto(p) p +#else +#define proto(p) () +#endif + +/* + * flags to sdbm_store + */ +#define DBM_INSERT 0 +#define DBM_REPLACE 1 + +/* + * ndbm interface + */ +extern DBM *sdbm_open proto((char *, int, int)); +extern void sdbm_close proto((DBM *)); +extern datum sdbm_fetch proto((DBM *, datum)); +extern int sdbm_delete proto((DBM *, datum)); +extern int sdbm_store proto((DBM *, datum, datum, int)); +extern datum sdbm_firstkey proto((DBM *)); +extern datum sdbm_nextkey proto((DBM *)); + +/* + * other + */ +extern DBM *sdbm_prep proto((char *, char *, int, int)); +extern long sdbm_hash proto((char *, int)); + +#ifndef SDBM_ONLY +#define dbm_open sdbm_open; +#define dbm_close sdbm_close; +#define dbm_fetch sdbm_fetch; +#define dbm_store sdbm_store; +#define dbm_delete sdbm_delete; +#define dbm_firstkey sdbm_firstkey; +#define dbm_nextkey sdbm_nextkey; +#define dbm_error sdbm_error; +#define dbm_clearerr sdbm_clearerr; +#endif diff --git a/ext/dbm/sdbm/tune.h b/ext/dbm/sdbm/tune.h new file mode 100644 index 0000000000..9d8a35b90b --- /dev/null +++ b/ext/dbm/sdbm/tune.h @@ -0,0 +1,34 @@ +/* + * sdbm - ndbm work-alike hashed database library + * tuning and portability constructs [not nearly enough] + * author: oz@nexus.yorku.ca + */ + +#define BYTESIZ 8 + +#ifdef SVID +#include <unistd.h> +#endif + +#ifdef BSD42 +#define SEEK_SET L_SET +#define memset(s,c,n) bzero(s, n) /* only when c is zero */ +#define memcpy(s1,s2,n) bcopy(s2, s1, n) +#define memcmp(s1,s2,n) bcmp(s1,s2,n) +#endif + +/* + * important tuning parms (hah) + */ + +#define SEEDUPS /* always detect duplicates */ +#define BADMESS /* generate a message for worst case: + cannot make room after SPLTMAX splits */ +/* + * misc + */ +#ifdef DEBUG +#define debug(x) printf x +#else +#define debug(x) +#endif diff --git a/ext/dbm/sdbm/util.c b/ext/dbm/sdbm/util.c new file mode 100644 index 0000000000..4b03d89f09 --- /dev/null +++ b/ext/dbm/sdbm/util.c @@ -0,0 +1,50 @@ +#include <stdio.h> +#ifdef SDBM +#include "sdbm.h" +#else +#include "ndbm.h" +#endif + +void +oops(s1, s2) +register char *s1; +register char *s2; +{ + extern int errno, sys_nerr; + extern char *sys_errlist[]; + extern char *progname; + + if (progname) + fprintf(stderr, "%s: ", progname); + fprintf(stderr, s1, s2); + if (errno > 0 && errno < sys_nerr) + fprintf(stderr, " (%s)", sys_errlist[errno]); + fprintf(stderr, "\n"); + exit(1); +} + +int +okpage(pag) +char *pag; +{ + register unsigned n; + register off; + register short *ino = (short *) pag; + + if ((n = ino[0]) > PBLKSIZ / sizeof(short)) + return 0; + + if (!n) + return 1; + + off = PBLKSIZ; + for (ino++; n; ino += 2) { + if (ino[0] > off || ino[1] > off || + ino[1] > ino[0]) + return 0; + off = ino[1]; + n -= 2; + } + + return 1; +} diff --git a/usub/man2mus b/ext/man2mus index a3046784f4..a3046784f4 100644 --- a/usub/man2mus +++ b/ext/man2mus diff --git a/ext/posix/POSIX.xs b/ext/posix/POSIX.xs new file mode 100644 index 0000000000..5918199cd8 --- /dev/null +++ b/ext/posix/POSIX.xs @@ -0,0 +1,10 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +MODULE = POSIX PACKAGE = POSIX + +FILE * +fdopen(fildes, type) + fd fildes + char * type diff --git a/usub/typemap b/ext/typemap index c11403b6df..29cd0513aa 100644 --- a/usub/typemap +++ b/ext/typemap @@ -226,3 +226,16 @@ 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 @@ -1,7 +1,7 @@ #!/usr/bin/perl # $Header$ -$usage = "Usage: tus [-a] [-s] [-c] typemap file.us\n"; +$usage = "Usage: xsubpp [-a] [-s] [-c] typemap file.xs\n"; die $usage unless (@ARGV >= 2 && @ARGV <= 6); SWITCH: while ($ARGV[0] =~ /^-/) { @@ -26,51 +26,66 @@ close(TYPEMAP); %input_expr = (JUNK, split(/\n(T_\w*)\s*\n/, <<'T_END')); T_INT - $var = (int)str_gnum($arg) + $var = (int)SvIV($arg) T_ENUM - $var = ($type)str_gnum($arg) + $var = ($type)SvIV($arg) T_U_INT - $var = (unsigned int)str_gnum($arg) + $var = (unsigned int)SvIV($arg) T_SHORT - $var = (short)str_gnum($arg) + $var = (short)SvIV($arg) T_U_SHORT - $var = (unsigned short)str_gnum($arg) + $var = (unsigned short)SvIV($arg) T_LONG - $var = (long)str_gnum($arg) + $var = (long)SvIV($arg) T_U_LONG - $var = (unsigned long)str_gnum($arg) + $var = (unsigned long)SvIV($arg) T_CHAR - $var = (char)*str_get($arg) + $var = (char)*SvPV($arg,na) T_U_CHAR - $var = (unsigned char)str_gnum($arg) + $var = (unsigned char)SvIV($arg) T_FLOAT - $var = (float)str_gnum($arg) + $var = (float)SvNV($arg) T_DOUBLE - $var = str_gnum($arg) + $var = SvNV($arg) T_STRING - $var = str_get($arg) + $var = SvPV($arg,na) T_PTR - $var = ($type)(unsigned long)str_gnum($arg) + $var = ($type)(unsigned long)SvNV($arg) +T_PTRREF + if (SvTYPE($arg) == SVt_REF) + $var = ($type)(unsigned long)SvNV((SV*)SvANY($arg)); + else + croak(\"$var is not a reference\") +T_PTROBJ + if (sv_isa($arg, \"${ntype}\")) + $var = ($type)(unsigned long)SvNV((SV*)SvANY($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*)SvANY($arg)); + $var = ${type}_desc->ptr; + } + else + croak(\"$var is not of type ${ntype}\") +T_REFREF + if (SvTYPE($arg) == SVt_REF) + $var = *($type)(unsigned long)SvNV((SV*)SvANY($arg)); + else + croak(\"$var is not a reference\") +T_REFOBJ + if (sv_isa($arg, \"${ntype}\")) + $var = *($type)(unsigned long)SvNV((SV*)SvANY($arg)); + else + croak(\"$var is not of type ${ntype}\") T_OPAQUE $var NOT IMPLEMENTED T_OPAQUEPTR - $var = ($type)str_get($arg) + $var = ($type)SvPV($arg,na) T_PACKED - $var = US_unpack_$ntype($arg) + $var = XS_unpack_$ntype($arg) T_PACKEDARRAY - $var = US_unpack_$ntype($arg) -T_REF - if (ref_ok($arg, \"${ntype}\")) - $var = *(${ntype}Ptr)$arg->str_magic->str_u.str_stab; - else - Tthrow(InvalidX(\"$var is not of type ${ntype}\")) -T_REFPTR - if (ref_ok($arg, \"$subtype\")) - $var = ($ntype)$arg->str_magic->str_u.str_stab; - else - Tthrow(InvalidX(\"$var is not of type $subtype\")) -T_DATAUNIT - $var = DataUnit(U32($arg->str_cur), (Octet*)$arg->str_ptr) + $var = XS_unpack_$ntype($arg) T_CALLBACK $var = make_perl_cb_$type($arg) T_ARRAY @@ -79,61 +94,75 @@ T_ARRAY while (items--) { DO_ARRAY_ELEM; } +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 - str_numset($arg, (double)$var); + sv_setiv($arg, (I32)$var); T_ENUM - str_numset($arg, (double)(int)$var); + sv_setiv($arg, (I32)$var); T_U_INT - str_numset($arg, (double)$var); + sv_setiv($arg, (I32)$var); T_SHORT - str_numset($arg, (double)$var); + sv_setiv($arg, (I32)$var); T_U_SHORT - str_numset($arg, (double)$var); + sv_setiv($arg, (I32)$var); T_LONG - str_numset($arg, (double)$var); + sv_setiv($arg, (I32)$var); T_U_LONG - str_numset($arg, (double)$var); + sv_setiv($arg, (I32)$var); T_CHAR - str_set($arg, (char *)&$var, 1); + sv_setpvn($arg, (char *)&$var, 1); T_U_CHAR - str_numset($arg, (double)$var); + sv_setiv($arg, (I32)$var); T_FLOAT - str_numset($arg, (double)$var); + sv_setnv($arg, (double)$var); T_DOUBLE - str_numset($arg, $var); + sv_setnv($arg, $var); T_STRING - str_set($arg, $var); + sv_setpv($arg, $var); T_PTR - str_numset($arg, (double)(unsigned long)$var); + 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 - str_nset($arg, (char *)&$var, sizeof($var)); + sv_setpvn($arg, (char *)&$var, sizeof($var)); T_OPAQUEPTR - str_nset($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var); + sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var); T_PACKED - US_pack_$ntype($arg, $var); + XS_pack_$ntype($arg, $var); T_PACKEDARRAY - US_pack_$ntype($arg, $var, count_$ntype); -T_REF - ref_construct($arg, \"${ntype}\", US_service_$ntype, - ($var ? (void*)new $ntype($var) : 0)); -T_REFPTR - NOT IMPLEMENTED + XS_pack_$ntype($arg, $var, count_$ntype); T_DATAUNIT - str_nset($arg, $var.chp(), $var.size()); + sv_setpvn($arg, $var.chp(), $var.size()); T_CALLBACK - str_nset($arg, $var.context.value().chp(), + 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) = str_mortal(&str_undef); + ST(ix_$var) = sv_mortalcopy(&sv_undef); DO_ARRAY_ELEM } sp += $var.size - 1; +T_DATUM + sv_setpvn($arg, $var.dptr, $var.dsize); +T_GDATUM + sv_usepvn($arg, $var.dptr, $var.dsize); T_END $uvfile = shift @ARGV; @@ -149,7 +178,7 @@ while (<F>) { print $_; } $Pack = $Package; -$Package .= "'" if defined $Package && $Package ne ""; +$Package .= "::" if defined $Package && $Package ne ""; $/ = ""; while (<F>) { @@ -164,7 +193,7 @@ while (<F>) { $Pack = $Package; $foo1 = $4; $Prefix = $5; - $Package .= "'" if defined $Package && $Package ne ""; + $Package .= "::" if defined $Package && $Package ne ""; next; } split(/[\t ]*\n/); @@ -227,11 +256,11 @@ while (<F>) { # print function header print <<"EOF" if $aflag; static int -US_${Pack}_$func_name(int, int sp, int items) +XS_${Pack}_$func_name(int, int sp, int items) EOF print <<"EOF" if !$aflag; static int -US_${Pack}_$func_name(ix, sp, items) +XS_${Pack}_$func_name(ix, sp, items) register int ix; register int sp; register int items; @@ -239,13 +268,13 @@ EOF print <<"EOF" if $elipsis; { if (items < $min_args) { - fatal("Usage: $pname($orig_args)"); + croak("Usage: $pname($orig_args)"); } EOF print <<"EOF" if !$elipsis; { if (items < $min_args || items > $num_args) { - fatal("Usage: $pname($orig_args)"); + croak("Usage: $pname($orig_args)"); } EOF @@ -280,6 +309,7 @@ EOF # do initialization of input variables $thisdone = 0; $retvaldone = 0; + $deferred = ""; while ($_ = shift(@_)) { last if /^\s*NOT_IMPLEMENTED_YET/; last if /^\s*(CODE|OUTPUT|CLEANUP|CASE)\s*:/; @@ -319,7 +349,7 @@ EOF # do code if (/^\s*NOT_IMPLEMENTED_YET/) { - print "\nfatal(\"$pname: not implemented yet\");\n"; + print "\ncroak(\"$pname: not implemented yet\");\n"; } else { if ($ret_type ne "void") { print "\t" . &map_type($ret_type) . "\tRETVAL;\n" @@ -327,6 +357,7 @@ EOF $args_match{"RETVAL"} = 0; $var_types{"RETVAL"} = $ret_type; } + print $deferred; if (/^\s*CODE:/) { while ($_ = shift(@_)) { last if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; @@ -335,7 +366,7 @@ EOF } else { print "\n\t"; if ($ret_type ne "void") { - print "RETVAL = (".&map_type($ret_type).")"; + print "RETVAL = "; } if (defined($static)) { print "$class::"; @@ -380,7 +411,7 @@ EOF } BEGHANDLERS CATCHALL - fatal("%s: %s\\tpropagated", Xname, Xreason); + croak("%s: %s\\tpropagated", Xname, Xreason); ENDHANDLERS EOF print <<EOF if !$eflag; @@ -400,13 +431,18 @@ EOF # print initialization routine print qq/extern "C"\n/ if $cflag; print <<"EOF"; -void init_$Module() +int init_$Module(ix,sp,items) +int ix; +int sp; +int items; { + char* file = __FILE__; + EOF for (@Func_name) { $pname = shift(@Func_pname); - print " make_usub(\"$pname\", 0, US_$_, __FILE__);\n"; + print " newXSUB(\"$pname\", 0, XS_$_, file);\n"; } print "}\n"; @@ -414,7 +450,7 @@ sub output_init { local($type, $num, $init) = @_; local($arg) = "ST($num)"; - eval "print \" $init\n\""; + eval qq/print " $init\\\n"/; } sub generate_init { @@ -441,11 +477,13 @@ sub generate_init { if (defined($defaults{$var})) { $expr =~ s/(\t+)/$1 /g; $expr =~ s/ /\t/g; - eval "print \"\t$var;\n\tif (items < $num)\n\t $var = $defaults{$var};\n\telse {\n$expr;\n\t}\n\""; + eval qq/print "\\t$var;\\n"/; + $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/; } elsif ($expr !~ /^\t\$var =/) { - eval "print \"\t$var;\n$expr;\n\""; + eval qq/print "\\t$var;\\n"/; + $deferred .= eval qq/"\\n$expr;\\n"/; } else { - eval "print \"$expr;\n\""; + eval qq/print "$expr;\\n"/; } } @@ -456,7 +494,7 @@ sub generate_output { local($ntype); if ($type =~ /^array\(([^,]*),(.*)\)/) { - print "\tstr_nset($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n"; + print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n"; } else { die "$type not in typemap" if !defined($type_kind{$type}); ($ntype = $type) =~ s/\s*\*/Ptr/g; @@ -473,6 +511,9 @@ sub generate_output { $subexpr =~ s/\n\t/\n\t\t/g; $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/; } + elsif ($arg eq 'ST(0)') { + print "\tST(0) = sv_mortalcopy(&sv_undef);\n"; + } eval "print qq\f$expr\f"; } } diff --git a/ext/xsubpp.bak b/ext/xsubpp.bak new file mode 100755 index 0000000000..0f309e3cd2 --- /dev/null +++ b/ext/xsubpp.bak @@ -0,0 +1,529 @@ +#!/usr/bin/perl +# $Header$ + +$usage = "Usage: xsubpp [-a] [-s] [-c] typemap file.xs\n"; +die $usage unless (@ARGV >= 2 && @ARGV <= 6); + +SWITCH: while ($ARGV[0] =~ /^-/) { + $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$/; + die $usage; +} + +$typemap = shift @ARGV; +open(TYPEMAP, $typemap) || die "cannot open $typemap\n"; +while (<TYPEMAP>) { + next if /^\s*$/ || /^#/; + chop; + ($typename, $kind) = split(/\t+/, $_, 2); + $type_kind{$typename} = $kind; +} +close(TYPEMAP); + +%input_expr = (JUNK, split(/\n(T_\w*)\s*\n/, <<'T_END')); + +T_INT + $var = (int)SvIVn($arg) +T_ENUM + $var = ($type)SvIVn($arg) +T_U_INT + $var = (unsigned int)SvIVn($arg) +T_SHORT + $var = (short)SvIVn($arg) +T_U_SHORT + $var = (unsigned short)SvIVn($arg) +T_LONG + $var = (long)SvIVn($arg) +T_U_LONG + $var = (unsigned long)SvIVn($arg) +T_CHAR + $var = (char)*SvPVn($arg,na) +T_U_CHAR + $var = (unsigned char)SvIVn($arg) +T_FLOAT + $var = (float)SvNVn($arg) +T_DOUBLE + $var = SvNVn($arg) +T_STRING + $var = SvPVn($arg,na) +T_PTR + $var = ($type)(unsigned long)SvNVn($arg) +T_PTRREF + if (SvTYPE($arg) == SVt_REF) + $var = ($type)(unsigned long)SvNVn((SV*)SvANY($arg)); + else + croak(\"$var is not a reference\") +T_PTROBJ + if (sv_isa($arg, \"${ntype}\")) + $var = ($type)(unsigned long)SvNVn((SV*)SvANY($arg)); + else + croak(\"$var is not of type ${ntype}\") +T_PTRDESC + if (sv_isa($arg, \"${ntype}\")) { + ${type}_desc = (\U${type}_DESC\E*)(unsigned long)SvNVn((SV*)SvANY($arg)); + $var = ${type}_desc->ptr; + } + else + croak(\"$var is not of type ${ntype}\") +T_REFREF + if (SvTYPE($arg) == SVt_REF) + $var = *($type)(unsigned long)SvNVn((SV*)SvANY($arg)); + else + croak(\"$var is not a reference\") +T_REFOBJ + if (sv_isa($arg, \"${ntype}\")) + $var = *($type)(unsigned long)SvNVn((SV*)SvANY($arg)); + else + croak(\"$var is not of type ${ntype}\") +T_OPAQUE + $var NOT IMPLEMENTED +T_OPAQUEPTR + $var = ($type)SvPVn($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; + } +T_DATUM + $var.dptr = SvPVn($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 + } + sp += $var.size - 1; +T_DATUM + sv_setpvn($arg, $var.dptr, $var.dsize); +T_GDATUM + sv_usepvn($arg, $var.dptr, $var.dsize); +T_END + +$uvfile = shift @ARGV; +open(F, $uvfile) || die "cannot open $uvfile\n"; + +if ($eflag) { + print qq|#include "cfm/basic.h"\n|; +} + +while (<F>) { + last if ($Module, $foo, $Package, $foo1, $Prefix) = + /^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(.+))?$/; + print $_; +} +$Pack = $Package; +$Package .= "::" if defined $Package && $Package ne ""; +$/ = ""; + +while (<F>) { + # parse paragraph + chop; + next if /^\s*$/; + next if /^(#.*\n?)+$/; + if (/^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(.+))?$/) { + $Module = $1; + $foo = $2; + $Package = $3; + $Pack = $Package; + $foo1 = $4; + $Prefix = $5; + $Package .= "::" if defined $Package && $Package ne ""; + next; + } + split(/[\t ]*\n/); + + # initialize info arrays + undef(%args_match); + undef(%var_types); + undef(%var_addr); + undef(%defaults); + undef($class); + undef($static); + undef($elipsis); + + # extract return type, function name and arguments + $ret_type = shift(@_); + if ($ret_type =~ /^static\s+(.*)$/) { + $static = 1; + $ret_type = $1; + } + $func_header = shift(@_); + ($func_name, $orig_args) = $func_header =~ /^([\w:]+)\s*\((.*)\)$/; + if ($func_name =~ /(.*)::(.*)/) { + $class = $1; + $func_name = $2; + } + ($pname = $func_name) =~ s/^($Prefix)?/$Package/; + push(@Func_name, "${Pack}_$func_name"); + push(@Func_pname, $pname); + @args = split(/\s*,\s*/, $orig_args); + if (defined($class) && !defined($static)) { + unshift(@args, "THIS"); + $orig_args = "THIS, $orig_args"; + $orig_args =~ s/^THIS, $/THIS/; + } + $orig_args =~ s/"/\\"/g; + $min_args = $num_args = @args; + foreach $i (0..$num_args-1) { + if ($args[$i] =~ s/\.\.\.//) { + $elipsis = 1; + $min_args--; + if ($args[i] eq '' && $i == $num_args - 1) { + pop(@args); + last; + } + } + if ($args[$i] =~ /([^=]*\S)\s*=\s*(.*)/) { + $min_args--; + $args[$i] = $1; + $defaults{$args[$i]} = $2; + $defaults{$args[$i]} =~ s/"/\\"/g; + } + } + if (defined($class) && !defined($static)) { + $func_args = join(", ", @args[1..$#args]); + } else { + $func_args = join(", ", @args); + } + @args_match{@args} = 1..@args; + + # print function header + print <<"EOF" if $aflag; +static int +XS_${Pack}_$func_name(int, int sp, 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)"); + } +EOF + print <<"EOF" if !$elipsis; +{ + if (items < $min_args || items > $num_args) { + croak("Usage: $pname($orig_args)"); + } +EOF + +# Now do a block of some sort. + +$condnum = 0; +if (!@_) { + @_ = "CLEANUP:"; +} +while (@_) { + if ($_[0] =~ s/^\s*CASE\s*:\s*//) { + $cond = shift(@_); + if ($condnum == 0) { + print " if ($cond)\n"; + } + elsif ($cond ne '') { + print " else if ($cond)\n"; + } + else { + print " else\n"; + } + $condnum++; + } + + print <<"EOF" if $eflag; + TRY { +EOF + print <<"EOF" if !$eflag; + { +EOF + + # do initialization of input variables + $thisdone = 0; + $retvaldone = 0; + $deferred = ""; + while ($_ = shift(@_)) { + last if /^\s*NOT_IMPLEMENTED_YET/; + last if /^\s*(CODE|OUTPUT|CLEANUP|CASE)\s*:/; + ($var_type, $var_name, $var_init) = + /\s*([^\t]+)\s*([^\s=]+)\s*(=.*)?/; + if ($var_name =~ /^&/) { + $var_name =~ s/^&//; + $var_addr{$var_name} = 1; + } + $thisdone |= $var_name eq "THIS"; + $retvaldone |= $var_name eq "RETVAL"; + $var_types{$var_name} = $var_type; + print "\t" . &map_type($var_type); + $var_num = $args_match{$var_name}; + if ($var_addr{$var_name}) { + $func_args =~ s/\b($var_name)\b/&\1/; + } + if ($var_init !~ /^=\s*NO_INIT\s*$/) { + if ($var_init !~ /^\s*$/) { + &output_init($var_type, $var_num, + "$var_name $var_init"); + } elsif ($var_num) { + # generate initialization code + &generate_init($var_type, $var_num, $var_name); + } else { + print ";\n"; + } + } else { + print "\t$var_name;\n"; + } + } + if (!$thisdone && defined($class) && !defined($static)) { + print "\t$class *"; + $var_types{"THIS"} = "$class *"; + &generate_init("$class *", 1, "THIS"); + } + + # do code + if (/^\s*NOT_IMPLEMENTED_YET/) { + print "\ncroak(\"$pname: not implemented yet\");\n"; + } else { + if ($ret_type ne "void") { + print "\t" . &map_type($ret_type) . "\tRETVAL;\n" + if !$retvaldone; + $args_match{"RETVAL"} = 0; + $var_types{"RETVAL"} = $ret_type; + } + print $deferred; + if (/^\s*CODE:/) { + while ($_ = shift(@_)) { + last if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; + print "$_\n"; + } + } else { + print "\n\t"; + if ($ret_type ne "void") { + print "RETVAL = "; + } + if (defined($static)) { + print "$class::"; + } elsif (defined($class)) { + print "THIS->"; + } + if (defined($spat) && $func_name =~ /^($spat)(.*)$/) { + $func_name = $2; + } + print "$func_name($func_args);\n"; + &generate_output($ret_type, 0, "RETVAL") + unless $ret_type eq "void"; + } + } + + # do output variables + if (/^\s*OUTPUT\s*:/) { + while ($_ = shift(@_)) { + last if /^\s*CLEANUP\s*:/; + s/^\s+//; + ($outarg, $outcode) = split(/\t+/); + if ($outcode) { + print "\t$outcode\n"; + } else { + die "$outarg not an argument" + unless defined($args_match{$outarg}); + $var_num = $args_match{$outarg}; + &generate_output($var_types{$outarg}, $var_num, + $outarg); + } + } + } + # do cleanup + if (/^\s*CLEANUP\s*:/) { + while ($_ = shift(@_)) { + last if /^\s*CASE\s*:/; + print "$_\n"; + } + } + # print function trailer + print <<EOF if $eflag; + } + BEGHANDLERS + CATCHALL + croak("%s: %s\\tpropagated", Xname, Xreason); + ENDHANDLERS +EOF + print <<EOF if !$eflag; + } +EOF + if (/^\s*CASE\s*:/) { + unshift(@_, $_); + } +} + print <<EOF; + return sp; +} + +EOF +} + +# print initialization routine +print qq/extern "C"\n/ if $cflag; +print <<"EOF"; +int init_$Module(ix,sp,items) +int ix; +int sp; +int items; +{ + char* file = __FILE__; + +EOF + +for (@Func_name) { + $pname = shift(@Func_pname); + print " newXSUB(\"$pname\", 0, XS_$_, file);\n"; +} +print "}\n"; + +sub output_init { + local($type, $num, $init) = @_; + local($arg) = "ST($num)"; + + eval qq/print " $init\\\n"/; +} + +sub generate_init { + local($type, $num, $var) = @_; + local($arg) = "ST($num)"; + local($argoff) = $num - 1; + local($ntype); + + die "$type not in typemap" if !defined($type_kind{$type}); + ($ntype = $type) =~ s/\s*\*/Ptr/g; + $subtype = $ntype; + $subtype =~ s/Ptr$//; + $subtype =~ s/Array$//; + $expr = $input_expr{$type_kind{$type}}; + if ($expr =~ /DO_ARRAY_ELEM/) { + $subexpr = $input_expr{$type_kind{$subtype}}; + $subexpr =~ s/ntype/subtype/g; + $subexpr =~ s/\$arg/ST(ix_$var)/g; + $subexpr =~ s/\n\t/\n\t\t/g; + $subexpr =~ s/is not of (.*")/[arg %d] is not of $1, ix_$var + 1/g; + $subexpr =~ s/\$var/$var[ix_$var - $argoff]/; + $expr =~ s/DO_ARRAY_ELEM/$subexpr/; + } + if (defined($defaults{$var})) { + $expr =~ s/(\t+)/$1 /g; + $expr =~ s/ /\t/g; + eval qq/print "\\t$var;\\n"/; + $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/; + } elsif ($expr !~ /^\t\$var =/) { + eval qq/print "\\t$var;\\n"/; + $deferred .= eval qq/"\\n$expr;\\n"/; + } else { + eval qq/print "$expr;\\n"/; + } +} + +sub generate_output { + local($type, $num, $var) = @_; + local($arg) = "ST($num)"; + local($argoff) = $num - 1; + local($ntype); + + if ($type =~ /^array\(([^,]*),(.*)\)/) { + print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n"; + } else { + die "$type not in typemap" if !defined($type_kind{$type}); + ($ntype = $type) =~ s/\s*\*/Ptr/g; + $ntype =~ s/\(\)//g; + $subtype = $ntype; + $subtype =~ s/Ptr$//; + $subtype =~ s/Array$//; + $expr = $output_expr{$type_kind{$type}}; + if ($expr =~ /DO_ARRAY_ELEM/) { + $subexpr = $output_expr{$type_kind{$subtype}}; + $subexpr =~ s/ntype/subtype/g; + $subexpr =~ s/\$arg/ST(ix_$var)/g; + $subexpr =~ s/\$var/${var}[ix_$var]/g; + $subexpr =~ s/\n\t/\n\t\t/g; + $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/; + } + elsif ($arg eq 'ST(0)') { + print "\tST(0) = sv_mortalcopy(&sv_undef);\n"; + } + eval "print qq\f$expr\f"; + } +} + +sub map_type { + local($type) = @_; + + if ($type =~ /^array\(([^,]*),(.*)\)/) { + return "$1 *"; + } else { + return $type; + } +} @@ -34,7 +34,7 @@ while (<F>) { /^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(\w+))?/; print $_; } -$Package .= "'" if defined $Package && $Package ne ""; +$Package .= "::" if defined $Package && $Package ne ""; print <<EOF; static struct varinfo varinfo [] = { EOF @@ -113,14 +113,14 @@ print <<EOF if $aflag; static unsigned long varinfolen = sizeof(varinfo)/sizeof(*varinfo); -static int UV_val(int ix, STR *str) +static int UV_val(int ix, SV *sv) { - return common_UV_val(varinfo, varinfolen, ix, str); + return common_UV_val(varinfo, varinfolen, ix, sv); } -static int UV_set(int ix, STR *str) +static int UV_set(int ix, SV *sv) { - return common_UV_set(varinfo, varinfolen, ix, str); + return common_UV_set(varinfo, varinfolen, ix, sv); } EOF print <<EOF if !$aflag; @@ -128,18 +128,18 @@ print <<EOF if !$aflag; static unsigned long varinfolen = sizeof(varinfo)/sizeof(*varinfo); -static int UV_val(ix, str) +static int UV_val(ix, sv) int ix; -STR *str; +SV *sv; { - return common_UV_val(varinfo, varinfolen, ix, str); + return common_UV_val(varinfo, varinfolen, ix, sv); } -static int UV_set(ix, str) +static int UV_set(ix, sv) int ix; -STR *str; +SV *sv; { - return common_UV_set(varinfo, varinfolen, ix, str); + return common_UV_set(varinfo, varinfolen, ix, sv); } EOF diff --git a/fixmac b/fixmac new file mode 100755 index 0000000000..c2f633b3fc --- /dev/null +++ b/fixmac @@ -0,0 +1,11 @@ +#!/usr/bin/perl -i.bak + +while (<>) { + s/\bSvIV\b/SvIVX/g; + s/\bSvNV\b/SvNVX/g; + s/\bSvPV\b/SvPVX/g; + s/\bSvIVn/SvIV/g; + s/\bSvNVn/SvNV/g; + s/\bSvPVn/SvPV/g; + print; +} @@ -0,0 +1,179 @@ +#!./perl + +print "1..37\n"; + +# Test glob operations. + +$bar = "ok 1\n"; +$foo = "ok 2\n"; +{ + local(*foo) = *bar; + print $foo; +} +print $foo; + +$baz = "ok 3\n"; +$foo = "ok 4\n"; +{ + local(*foo) = 'baz'; + print $foo; +} +print $foo; + +$foo = "ok 6\n"; +{ + local(*foo); + print $foo; + $foo = "ok 5\n"; + print $foo; +} +print $foo; + +# Test fake references. + +$baz = "ok 7\n"; +$bar = 'baz'; +$foo = 'bar'; +print $$$foo; + +# Test real references. + +$FOO = \$BAR; +$BAR = \$BAZ; +$BAZ = "ok 8\n"; +print $$$FOO; + +# Test references to real arrays. + +@ary = (9,10,11,12); +$ref[0] = \@a; +$ref[1] = \@b; +$ref[2] = \@c; +$ref[3] = \@d; +for $i (3,1,2,0) { + push(@{$ref[$i]}, "ok $ary[$i]\n"); +} +print @a; +print ${$ref[1]}[0]; +print @{$ref[2]}[0]; +print @{'d'}; + +# Test references to references. + +$refref = \\$x; +$x = "ok 13\n"; +print $$$refref; + +# Test nested anonymous lists. + +$ref = [[],2,[3,4,5,]]; +print scalar @$ref == 3 ? "ok 14\n" : "not ok 14\n"; +print $$ref[1] == 2 ? "ok 15\n" : "not ok 15\n"; +print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n"; +print scalar @{$$ref[0]} == 0 ? "ok 17\n" : "not ok 17\n"; + +print $ref->[1] == 2 ? "ok 18\n" : "not ok 18\n"; +print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 18\n"; + +# Test references to hashes of references. + +$refref = \%whatever; +$refref->{"key"} = $ref; +print $refref->{"key"}->[2]->[0] == 3 ? "ok 20\n" : "not ok 20\n"; + +# Test to see if anonymous subarrays spring into existence. + +$spring[5]->[0] = 123; +$spring[5]->[1] = 456; +push(@{$spring[5]}, 789); +print join(':',@{$spring[5]}) eq "123:456:789" ? "ok 21\n" : "not ok 21\n"; + +# Test to see if anonymous subhashes spring into existence. + +@{$spring2{"foo"}} = (1,2,3); +$spring2{"foo"}->[3] = 4; +print join(':',@{$spring2{"foo"}}) eq "1:2:3:4" ? "ok 22\n" : "not ok 22\n"; + +# Test references to subroutines. + +sub mysub { print "ok 23\n" } +$subref = \&mysub; +&$subref; + +$subrefref = \\&mysub2; +&$$subrefref("ok 24\n"); +sub mysub2 { print shift } + +# Test the ref operator. + +print ref $subref eq CODE ? "ok 25\n" : "not ok 25\n"; +print ref $ref eq ARRAY ? "ok 26\n" : "not ok 26\n"; +print ref $refref eq HASH ? "ok 27\n" : "not ok 27\n"; + +# Test anonymous hash syntax. + +$anonhash = {}; +print ref $anonhash eq HASH ? "ok 28\n" : "not ok 28\n"; +$anonhash2 = {FOO => BAR, ABC => XYZ,}; +print join('', sort values %$anonhash2) eq BARXYZ ? "ok 29\n" : "not ok 29\n"; + +# Test bless operator. + +package MYHASH; + +$object = bless $main'anonhash2; +print ref $object eq MYHASH ? "ok 30\n" : "not ok 30\n"; +print $object->{ABC} eq XYZ ? "ok 31\n" : "not ok 31\n"; + +$object2 = bless {}; +print ref $object2 eq MYHASH ? "ok 32\n" : "not ok 32\n"; + +# Test ordinary call on object method. + +&mymethod($object,33); + +sub mymethod { + local($THIS, @ARGS) = @_; + die "Not a MYHASH" unless ref $THIS eq MYHASH; + print $THIS->{FOO} eq BAR ? "ok $ARGS[0]\n" : "not ok $ARGS[0]\n"; +} + +# Test automatic destructor call. + +$string = "not ok 34\n"; +$object = "foo"; +$string = "ok 34\n"; +$main'anonhash2 = "foo"; +$string = "not ok 34\n"; + +sub DESTROY { + print $string; + + # Test that the object has already been "cursed". + print ref shift eq HASH ? "ok 35\n" : "not ok 35\n"; +} + +# Now test inheritance of methods. + +package OBJ; + +@ISA = (BASEOBJ); + +$main'object = bless {FOO => foo, BAR => bar}; + +package main; + +# Test arrow-style method invocation. + +print $object->doit("BAR") eq bar ? "ok 36\n" : "not ok 36\n"; + +# Test indirect-object-style method invocation. + +$foo = doit $object "FOO"; +print $foo eq foo ? "ok 37\n" : "not ok 37\n"; + +sub BASEOBJ'doit { + local $ref = shift; + die "Not an OBJ" unless ref $ref eq OBJ; + $ref->{shift}; +} @@ -1,4 +1,5 @@ #!./perl -BEGIN { $/ = "" } -print while <>; +# Test the singlequoted eval optimizer + +for (1..1) { } diff --git a/functab.h,v b/functab.h,v deleted file mode 100644 index 5b3c96f419..0000000000 --- a/functab.h,v +++ /dev/null @@ -1,2854 +0,0 @@ -head 20301.49; -access ; -symbols r03_01_13:20301.49 r03_01_12:20301.47 r03_01_11:20301.47 r03_01_10:20301.47 r03_01_09:20301.47 r03_01_08:20301.47 r03_01_07:20301.47 r03_01_06:20301.46 r03_01_05:20301.46 trout-farm:20301.43.1.1 r03_01_04:20301.45 r03_01_03:20301.43.1.1 r03_01_02:20301.43 r03_01_01:20301.43 r03_01_00:20301.43 r03_00_02:20301.41.1.1 r03_00_01:20301.38 r03_00_00:20301.37 r02_02_03_hp:20301.6 r02_02_02_hp:20301.2 r02_02_01_hp:20201.35 stage_02:20201.35 stage_01:20201.35 r02_01_09_hp:20103.1.1.1.1.1 r02_01_08_hp:20103.1.1.1.1.1 r02_01_07_hp:20103.1.1.1 r02_01_06_hp:20103.1.1.1 r02_01_05_hp:20103.1 r02_02_00_hp:20201.28 r02_01_04_hp:20103.1 r02_01_03_hp:20103.1 r02_01_02_hp:20102.3 r02_01_01_hp:1.4 r02_01_00_hp:1.2 stage:1.2 r01_00_41_hp:1.1; -locks ; strict; -comment @ * @; - - -20301.49 -date 91.07.15.11.01.55; author twood; state r03_01_13; -branches ; -next 20301.48; - -20301.48 -date 91.07.11.16.16.43; author twood; state Exp; -branches ; -next 20301.47; - -20301.47 -date 91.05.31.15.16.41; author twood; state r03_01_12; -branches ; -next 20301.46; - -20301.46 -date 91.05.16.13.14.38; author twood; state r03_01_06; -branches ; -next 20301.45; - -20301.45 -date 91.05.08.16.32.02; author twood; state r03_01_04; -branches ; -next 20301.44; - -20301.44 -date 91.05.07.15.56.50; author twood; state Exp; -branches ; -next 20301.43; - -20301.43 -date 91.04.09.09.15.58; author twood; state r03_01_03; -branches 20301.43.1.1; -next 20301.42; - -20301.42 -date 91.03.27.15.42.43; author twood; state Exp; -branches ; -next 20301.41; - -20301.41 -date 91.03.27.10.35.38; author twood; state Exp; -branches 20301.41.1.1; -next 20301.40; - -20301.40 -date 91.03.25.14.36.14; author twood; state Exp; -branches ; -next 20301.39; - -20301.39 -date 91.03.21.10.47.45; author melodi; state Exp; -branches ; -next 20301.38; - -20301.38 -date 91.03.19.09.59.42; author twood; state r03_00_01; -branches ; -next 20301.37; - -20301.37 -date 91.03.05.13.03.52; author melodi; state Exp; -branches ; -next 20301.36; - -20301.36 -date 91.03.05.10.46.57; author melodi; state Exp; -branches ; -next 20301.35; - -20301.35 -date 91.02.19.09.32.29; author twood; state Exp; -branches ; -next 20301.34; - -20301.34 -date 91.02.13.16.19.01; author twood; state Exp; -branches ; -next 20301.33; - -20301.33 -date 91.02.08.12.33.50; author melodi; state Exp; -branches ; -next 20301.32; - -20301.32 -date 91.02.05.14.40.10; author melodi; state Exp; -branches ; -next 20301.31; - -20301.31 -date 91.01.25.11.41.11; author melodi; state Exp; -branches ; -next 20301.30; - -20301.30 -date 91.01.25.08.54.11; author twood; state Exp; -branches ; -next 20301.29; - -20301.29 -date 91.01.25.08.47.41; author melodi; state Exp; -branches ; -next 20301.28; - -20301.28 -date 91.01.23.15.18.20; author twood; state Exp; -branches ; -next 20301.27; - -20301.27 -date 91.01.22.16.30.23; author melodi; state Exp; -branches ; -next 20301.26; - -20301.26 -date 91.01.22.11.51.03; author pepler; state Exp; -branches ; -next 20301.25; - -20301.25 -date 91.01.17.14.03.19; author greg; state Exp; -branches ; -next 20301.24; - -20301.24 -date 91.01.17.11.05.36; author pepler; state Exp; -branches ; -next 20301.23; - -20301.23 -date 91.01.16.16.20.24; author greg; state Exp; -branches ; -next 20301.22; - -20301.22 -date 91.01.15.12.35.53; author greg; state Exp; -branches ; -next 20301.21; - -20301.21 -date 91.01.11.12.16.03; author greg; state Exp; -branches ; -next 20301.20; - -20301.20 -date 91.01.11.10.41.39; author melodi; state Exp; -branches ; -next 20301.19; - -20301.19 -date 91.01.03.14.31.49; author twood; state Exp; -branches ; -next 20301.18; - -20301.18 -date 91.01.02.11.02.45; author greg; state Exp; -branches ; -next 20301.17; - -20301.17 -date 90.12.28.17.21.08; author greg; state Exp; -branches ; -next 20301.16; - -20301.16 -date 90.12.21.10.18.52; author greg; state Exp; -branches ; -next 20301.15; - -20301.15 -date 90.12.19.17.38.10; author greg; state Exp; -branches ; -next 20301.14; - -20301.14 -date 90.12.19.08.40.09; author twood; state Exp; -branches ; -next 20301.13; - -20301.13 -date 90.12.17.08.20.40; author greg; state Exp; -branches ; -next 20301.12; - -20301.12 -date 90.12.13.08.11.32; author greg; state Exp; -branches ; -next 20301.11; - -20301.11 -date 90.12.10.09.32.39; author greg; state Exp; -branches ; -next 20301.10; - -20301.10 -date 90.12.10.08.59.12; author twood; state Exp; -branches ; -next 20301.9; - -20301.9 -date 90.12.03.11.56.24; author pepler; state Exp; -branches ; -next 20301.8; - -20301.8 -date 90.11.29.12.06.14; author melodi; state Exp; -branches ; -next 20301.7; - -20301.7 -date 90.11.29.11.37.42; author twood; state Exp; -branches ; -next 20301.6; - -20301.6 -date 90.11.16.14.46.42; author pepler; state r02_02_03_hp; -branches ; -next 20301.5; - -20301.5 -date 90.11.16.13.47.22; author melodi; state Exp; -branches ; -next 20301.4; - -20301.4 -date 90.11.15.14.45.11; author melodi; state Exp; -branches ; -next 20301.3; - -20301.3 -date 90.11.14.15.18.28; author twood; state Exp; -branches ; -next 20301.2; - -20301.2 -date 90.11.14.08.13.16; author greg; state r02_02_02_hp; -branches ; -next 20301.1; - -20301.1 -date 90.11.13.09.55.08; author greg; state Exp; -branches ; -next 20201.38; - -20201.38 -date 90.11.07.17.00.01; author melodi; state Exp; -branches ; -next 20201.37; - -20201.37 -date 90.11.07.16.58.34; author greg; state Exp; -branches ; -next 20201.36; - -20201.36 -date 90.11.07.16.09.07; author twood; state Exp; -branches ; -next 20201.35; - -20201.35 -date 90.10.25.10.40.53; author melodi; state r02_02_01_hp; -branches ; -next 20201.34; - -20201.34 -date 90.10.24.17.31.46; author melodi; state Exp; -branches ; -next 20201.33; - -20201.33 -date 90.10.23.16.22.21; author greg; state Exp; -branches ; -next 20201.32; - -20201.32 -date 90.10.23.09.06.11; author twood; state Exp; -branches ; -next 20201.31; - -20201.31 -date 90.10.22.12.18.42; author melodi; state Exp; -branches ; -next 20201.30; - -20201.30 -date 90.10.22.11.40.59; author twood; state Exp; -branches ; -next 20201.29; - -20201.29 -date 90.10.19.11.59.03; author greg; state Exp; -branches ; -next 20201.28; - -20201.28 -date 90.10.16.14.10.59; author greg; state r02_02_00_hp; -branches ; -next 20201.27; - -20201.27 -date 90.10.15.08.51.32; author greg; state Exp; -branches ; -next 20201.26; - -20201.26 -date 90.10.12.11.29.14; author twood; state Exp; -branches ; -next 20201.25; - -20201.25 -date 90.10.02.12.28.18; author greg; state sandbox; -branches ; -next 20201.24; - -20201.24 -date 90.10.02.11.06.06; author greg; state Exp; -branches ; -next 20201.23; - -20201.23 -date 90.09.28.11.13.27; author greg; state Exp; -branches ; -next 20201.22; - -20201.22 -date 90.09.28.10.17.28; author twood; state Exp; -branches ; -next 20201.21; - -20201.21 -date 90.09.25.13.05.13; author greg; state Exp; -branches ; -next 20201.20; - -20201.20 -date 90.09.24.16.26.29; author twood; state Exp; -branches ; -next 20201.19; - -20201.19 -date 90.09.10.10.53.22; author twood; state Exp; -branches ; -next 20201.18; - -20201.18 -date 90.09.10.10.39.48; author greg; state Exp; -branches ; -next 20201.17; - -20201.17 -date 90.08.29.14.27.40; author twood; state Exp; -branches ; -next 20201.16; - -20201.16 -date 90.08.29.13.03.02; author melodi; state Exp; -branches ; -next 20201.15; - -20201.15 -date 90.08.17.15.52.55; author twood; state Exp; -branches ; -next 20201.14; - -20201.14 -date 90.08.14.13.11.15; author twood; state Exp; -branches ; -next 20201.13; - -20201.13 -date 90.08.14.12.39.43; author melodi; state Exp; -branches ; -next 20201.12; - -20201.12 -date 90.08.10.10.15.52; author melodi; state Exp; -branches ; -next 20201.11; - -20201.11 -date 90.08.08.15.13.21; author greg; state Exp; -branches ; -next 20201.10; - -20201.10 -date 90.08.08.14.22.52; author greg; state Exp; -branches ; -next 20201.9; - -20201.9 -date 90.08.07.09.22.07; author melodi; state Exp; -branches ; -next 20201.8; - -20201.8 -date 90.08.07.08.29.22; author melodi; state Exp; -branches ; -next 20201.7; - -20201.7 -date 90.08.06.12.21.43; author twood; state Exp; -branches ; -next 20201.6; - -20201.6 -date 90.07.26.15.49.03; author melodi; state Exp; -branches ; -next 20201.5; - -20201.5 -date 90.07.26.13.37.53; author melodi; state Exp; -branches ; -next 20201.4; - -20201.4 -date 90.07.24.11.11.21; author melodi; state Exp; -branches ; -next 20201.3; - -20201.3 -date 90.07.17.13.41.20; author melodi; state Exp; -branches ; -next 20201.2; - -20201.2 -date 90.06.14.10.43.29; author greg; state Exp; -branches ; -next 20201.1; - -20201.1 -date 90.06.12.10.37.36; author greg; state Exp; -branches ; -next 20103.1; - -20103.1 -date 90.05.17.08.57.08; author melodi; state r02_01_05_hp; -branches 20103.1.1.1; -next 20102.3; - -20102.3 -date 90.05.08.08.56.46; author ricks; state r02_01_02_hp; -branches ; -next 20102.2; - -20102.2 -date 90.05.03.08.00.21; author greg; state r02_01_02_hp; -branches ; -next 20102.1; - -20102.1 -date 90.04.30.14.22.39; author greg; state r02_01_02_hp; -branches ; -next 1.5; - -1.5 -date 90.04.30.09.53.46; author greg; state Exp; -branches ; -next 1.4; - -1.4 -date 90.04.20.16.43.05; author greg; state r02_01_02_hp; -branches ; -next 1.3; - -1.3 -date 90.04.17.15.03.42; author greg; state Exp; -branches ; -next 1.2; - -1.2 -date 90.03.14.15.23.08; author admin; state r02_01_00_hp; -branches ; -next 1.1; - -1.1 -date 90.03.12.11.58.44; author rampson; state Exp; -branches ; -next ; - -20103.1.1.1 -date 90.07.26.14.56.36; author twood; state r02_01_07_hp; -branches 20103.1.1.1.1.1; -next 20103.1.1.2; - -20103.1.1.2 -date 90.08.13.11.13.31; author melodi; state Exp; -branches ; -next ; - -20103.1.1.1.1.1 -date 90.08.16.14.19.32; author greg; state r02_01_09_hp; -branches ; -next ; - -20301.41.1.1 -date 91.03.27.15.46.26; author twood; state r03_00_02; -branches ; -next ; - -20301.43.1.1 -date 91.05.08.12.56.08; author rfullmer; state trout-farm; -branches ; -next ; - - -desc -@@ - - -20301.49 -log -@CR#10427:M:added sr08load. -@ -text -@/***************************************************************************** -* -* CONFIDENTIAL -* Disclose And Distribute Solely To Employees Of -* U S WEST And It's Affiliates Having A Need To Know. -* -*------------------------------------------------------------------------ -* -* (c)Copyright 1990, U S WEST Information Technologies Group -* All Rights Reserved -* -******************************************************************************/ -@ - - -20301.48 -log -@CR#10488:M:changed upent9/10 & downent9/10 to upent11/12 & downent11/12 -@ -text -@d24 3 -d570 1 -@ - - -20301.47 -log -@CR#10237:M:added sr16 ???NextPagePart functions. -@ -text -@d24 3 -d473 2 -a474 2 - {"downent10", (caddr_t)downent10}, - {"downent9", (caddr_t)downent9}, -d580 2 -a581 2 - {"upent10", (caddr_t)upent10}, - {"upent9", (caddr_t)upent9}, -@ - - -20301.46 -log -@ CR#9586:M:added slider bars to screendisp -@ -text -@d24 3 -d303 1 -d306 1 -d313 1 -d326 1 -d345 1 -@ - - -20301.45 -log -@CR#9912:M:changed BOSSCSBlIbal to BOSSCSBLIbal (capitalized the first L) -@ -text -@d24 3 -d281 1 -d352 1 -@ - - -20301.44 -log -@ CR#9912:M:added BOSSCSBlIbal -@ -text -@d24 3 -d275 1 -a275 1 - {"BOSSCSBlIbal", (caddr_t)BOSSCSBlIbal}, -d369 1 -@ - - -20301.43 -log -@CR#9279:M:removed collections -@ -text -@d24 3 -d272 1 -a321 1 - {"MakeTreatTypeText", (caddr_t)MakeTreatTypeText}, -@ - - -20301.43.1.1 -log -@CR#9904:M:Remove MakeTreatTypeText reference -@ -text -@a23 3 - * Revision 20301.43 91/04/09 09:15:58 09:15:58 twood (Tim Woodward) - * CR#9279:M:removed collections - * -d318 1 -@ - - -20301.42 -log -@ CR#9279:M:deleted change_trfuuid and change_hostid -@ -text -@d24 3 -a426 2 - {"collectdcback", (caddr_t)collectdcback}, - {"collections", (caddr_t)collections}, -@ - - -20301.41 -log -@CR#9532:M:deleted Check Exit -@ -text -@d276 1 -a400 2 - {"change_hostid", (caddr_t)change_hostid}, - {"change_trfuuid", (caddr_t)change_trfuuid}, -@ - - -20301.41.1.1 -log -@ CR#9596:M:deleted change_trfuuid and change_hostid -@ -text -@a23 3 - * Revision 20301.41 91/03/27 10:35:38 10:35:38 twood (Tim Woodward) - * CR#9532:M:deleted Check Exit - * -d400 2 -@ - - -20301.40 -log -@CR#9532:M:added CheckExit -@ -text -@d24 3 -a262 1 - {"CheckExit", (caddr_t)CheckExit}, -@ - - -20301.39 -log -@CR#9492:M:Bring up UBIC Summary when UBIC flup selected from QTFU/TRFU -@ -text -@d24 3 -d260 1 -@ - - -20301.38 -log -@ CR#9458:M: added BuildDialog funcs -@ -text -@d24 3 -d270 1 -a398 1 - {"checklock", (caddr_t)checklock}, -@ - - -20301.37 -log -@add AmtTtlDpstAccnt -@ -text -@d24 3 -d259 2 -@ - - -20301.36 -log -@remove obsolete nextserfunc -@ -text -@d24 3 -d246 1 -@ - - -20301.35 -log -@added OTCEntAmt1 and OTCEntAmt2 -@ -text -@d24 3 -a479 1 - {"nextserfunc", (caddr_t)nextserfunc}, -@ - - -20301.34 -log -@added requestcpal and change_hostid -@ -text -@d24 3 -d305 2 -@ - - -20301.33 -log -@remove follow through actions, add new traversable buttons & window ID -indicator -@ -text -@d24 4 -d329 1 -d373 1 -@ - - -20301.32 -log -@add NextPayFill() -@ -text -@d24 3 -d287 1 -@ - - -20301.31 -log -@work on prev bill & Forward for pay/adj -@ -text -@d24 3 -d287 1 -@ - - -20301.30 -log -@CR#7187:M:removed GetCPAL -@ -text -@d24 3 -d309 1 -@ - - -20301.29 -log -@added NextPay() -@ -text -@d24 3 -a257 1 - {"GetCPAL", (caddr_t)GetCPAL}, -@ - - -20301.28 -log -@CR#7588:M: added GetCPAL and CSBlIbal -@ -text -@d24 3 -d278 1 -@ - - -20301.27 -log -@added ShowPayAdj -@ -text -@d24 3 -d230 1 -d252 1 -@ - - -20301.26 -log -@CR#8822:M:remove natmodes -@ -text -@d24 3 -d263 1 -a263 1 - {"LowEnttyID", (caddr_t)LowEnttyID}, -d304 2 -a313 2 - {"SONARpsw", (caddr_t)SONARpsw}, - {"SOPADpsw", (caddr_t)SOPADpsw}, -d315 1 -@ - - -20301.25 -log -@CR#7170:M: Added getdefaultval function -@ -text -@d24 3 -a433 1 - {"natmodes", (caddr_t)natmodes}, -@ - - -20301.24 -log -@CR#8822:M:added autologon functions -@ -text -@d24 3 -d398 1 -@ - - -20301.23 -log -@CR#7170:M: Worked on note cooperation -@ -text -@d24 3 -d206 3 -d214 1 -d224 1 -d232 1 -d249 3 -d303 2 -d428 1 -@ - - -20301.22 -log -@CR#7170:M: Made LoadFollowUpKeys() function -@ -text -@d24 3 -d225 1 -d246 1 -d263 1 -d280 1 -a376 1 - {"fix_buttons", (caddr_t)fix_buttons}, -@ - - -20301.21 -log -@CR#7170:M: Added StippleButton function -@ -text -@d24 3 -d236 1 -@ - - -20301.20 -log -@CR#8718:M:New payments & adjustments functionality -@ -text -@d24 3 -d281 1 -@ - - -20301.19 -log -@CR#7187:M: added sr14load -@ -text -@d24 3 -d221 1 -d231 1 -d250 1 -d260 1 -@ - - -20301.18 -log -@CR#7169:M: Worked on genericizing lists -@ -text -@d24 3 -d444 1 -@ - - -20301.17 -log -@CR#7170:M: Generalized the Trfu and Qtfu shared functions for all lists -@ -text -@d24 3 -d200 1 -d213 1 -d242 1 -@ - - -20301.16 -log -@CR#7192:M: Worked on TRFU and QTFU follow thru code -@ -text -@d24 3 -d185 4 -d194 1 -d220 2 -a221 1 - {"MakeTreatText", (caddr_t)MakeTreatText}, -a236 1 - {"Prev_month_valuator", (caddr_t)Prev_month_valuator}, -d239 1 -d250 2 -a252 7 - {"RequestTSUM", (caddr_t)RequestTSUM}, - {"SaveFollowUpVariables", (caddr_t)SaveFollowUpVariables}, - {"SelectFollowUpItem", (caddr_t)SelectFollowUpItem}, - {"SendDataToCLSA", (caddr_t)SendDataToCLSA}, - {"Set120LineList", (caddr_t)Set120LineList}, - {"SetDataFields", (caddr_t)SetDataFields}, - {"ShortenFollowUpList", (caddr_t)ShortenFollowUpList}, -d258 4 -d266 1 -d294 1 -d296 1 -a297 1 - {"checkpi", (caddr_t)checkpi}, -d300 2 -a312 2 - {"closeRestCallback", (caddr_t)closeRestCallback}, - {"closeWinCallback", (caddr_t)closeWinCallback}, -a316 1 - {"crtranhead", (caddr_t)crtranhead}, -d333 1 -d340 1 -a341 1 - {"downent10", (caddr_t)downent10}, -d370 1 -a371 1 - {"list_deposit", (caddr_t)list_deposit}, -d418 1 -a424 1 - {"send_refund", (caddr_t)send_refund}, -d447 1 -a448 1 - {"upent10", (caddr_t)upent10}, -@ - - -20301.15 -log -@CR#7192:M: Worked on QTFU -@ -text -@d23 4 -a26 1 -* $Log: functab.h,v $ -d244 1 -d248 1 -@ - - -20301.14 -log -@CR#7174:M: added requestTSUM -@ -text -@d3 3 -a5 3 -* CONFIDENTIAL -* Disclose And Distribute Solely To Employees Of -* U S WEST And It's Affiliates Having A Need To Know. -d9 2 -a10 2 -* (c)Copyright 1990, U S WEST Information Technologies Group -* All Rights Reserved -d23 4 -a26 1 -* $Log: functab.h,v $ -d160 1 -a160 1 -* THIS CODE HAS NOT BEEN MADE TO COMPLY WITH NEW STANDARDS ! -d177 1 -a177 1 -Tabfunc functable[] = -d179 261 -a439 252 - {"BOSSDateEffctv", (caddr_t)BOSSDateEffctv}, - {"CB", (caddr_t)CB}, - {"CBED", (caddr_t)CBED}, - {"CSRData", (caddr_t)CSRData}, - {"CancelTRFU", (caddr_t)CancelTRFU}, - {"CchEnttySmmry", (caddr_t)CchEnttySmmry}, - {"ClearEnd", (caddr_t)ClearEnd}, - {"CloseUbic", (caddr_t)CloseUbic}, - {"CpalCodeEntity", (caddr_t)CpalCodeEntity}, - {"CustPayAmt", (caddr_t)CustPayAmt}, - {"DADGenericImage", (caddr_t)DADGenericImage}, - {"DETAILUbicImage", (caddr_t)DETAILUbicImage}, - {"DOAGenericImage", (caddr_t)DOAGenericImage}, - {"DS", (caddr_t)DS}, - {"Deposits", (caddr_t)Deposits}, - {"EnterObject", (caddr_t)EnterObject}, - {"FYIGenericImage", (caddr_t)FYIGenericImage}, - {"FindDataSource", (caddr_t)FindDataSource}, - {"FixTeList", (caddr_t)FixTeList}, - {"HashGetObject", (caddr_t)HashGetObject}, - {"IdEnttySmmry", (caddr_t)IdEnttySmmry}, - {"InfoPrntImg", (caddr_t)InfoPrntImg}, - {"InfoPrntImge", (caddr_t)InfoPrntImge}, - {"InsertToggle", (caddr_t)InsertToggle}, - {"LP", (caddr_t)LP}, - {"LPED", (caddr_t)LPED}, - {"LUDGenericImage", (caddr_t)LUDGenericImage}, - {"LeaveObject", (caddr_t)LeaveObject}, - {"MakeTranUsable", (caddr_t)MakeTranUsable}, - {"MakeTreatText", (caddr_t)MakeTreatText}, - {"MoveNextEditor", (caddr_t)MoveNextEditor}, - {"MovePreviousEditor", (caddr_t)MovePreviousEditor}, - {"NextTRFU", (caddr_t)NextTRFU}, - {"OCDGenericImage", (caddr_t)OCDGenericImage}, - {"OTCDiscChrg", (caddr_t)OTCDiscChrg}, - {"OTCDiscCodes", (caddr_t)OTCDiscCodes}, - {"OTCDscrtnryAr", (caddr_t)OTCDscrtnryAr}, - {"OpenTRFU", (caddr_t)OpenTRFU}, - {"OpenTreatment", (caddr_t)OpenTreatment}, - {"PB", (caddr_t)PB}, - {"PBED", (caddr_t)PBED}, - {"PE", (caddr_t)PE}, - {"PEED", (caddr_t)PEED}, - {"Prev_month_valuator", (caddr_t)Prev_month_valuator}, - {"PrevTRFU", (caddr_t)PrevTRFU}, - {"QtfuLoad", (caddr_t)QtfuLoad}, - {"RB", (caddr_t)RB}, - {"RBED", (caddr_t)RBED}, - {"RaiseCLSA", (caddr_t)RaiseCLSA}, - {"RaiseQtfu", (caddr_t)RaiseQtfu}, - {"RaiseTreatment", (caddr_t)RaiseTreatment}, - {"RaiseUbicDetail", (caddr_t)RaiseUbicDetail}, - {"RaiseUbicSummary", (caddr_t)RaiseUbicSummary}, - {"RequestTRFU", (caddr_t)RequestTRFU}, - {"RequestTSUM", (caddr_t)RequestTSUM}, - {"SendDataToCLSA", (caddr_t)SendDataToCLSA}, - {"SetDataFields", (caddr_t)SetDataFields}, - {"SR", (caddr_t)SR}, - {"SRED", (caddr_t)SRED}, - {"SUMMARYUbicImage", (caddr_t)SUMMARYUbicImage}, - {"SW", (caddr_t)SW}, - {"SWED", (caddr_t)SWED}, - {"TB", (caddr_t)TB}, - {"TBED", (caddr_t)TBED}, - {"TE", (caddr_t)TE}, - {"TEED", (caddr_t)TEED}, - {"TreatPayLoad", (caddr_t)TreatPayLoad}, - {"TrfuFill", (caddr_t)TrfuFill}, - {"TrfuLoad", (caddr_t)TrfuLoad}, - {"TsumInfo", (caddr_t)TsumInfo}, - {"TtlsEnttySmmry", (caddr_t)TtlsEnttySmmry}, - {"UbicSelect", (caddr_t)UbicSelect}, - {"WindowID", (caddr_t)WindowID}, - {"activate", (caddr_t)activate}, - {"addlcarrier", (caddr_t)addlcarrier}, - {"adjustitem", (caddr_t)adjustitem}, - {"adlitem", (caddr_t)adlitem}, - {"allocmem", (caddr_t)allocmem}, - {"billcarrier", (caddr_t)billcarrier}, - {"cancelallrefs", (caddr_t)cancelallrefs}, - {"candshdhist", (caddr_t)candshdhist}, - {"canpi", (caddr_t)canpi}, - {"canref", (caddr_t)canref}, - {"cansi", (caddr_t)cansi}, - {"cantrthist", (caddr_t)cantrthist}, - {"carrierlst", (caddr_t)carrierlst}, - {"cartask", (caddr_t)cartask}, - {"carvals", (caddr_t)carvals}, - {"change_trfuuid", (caddr_t)change_trfuuid}, - {"checkdb", (caddr_t)checkdb}, - {"checkentinfo", (caddr_t)checkentinfo}, - {"checkind", (caddr_t)checkind}, - {"checknote", (caddr_t)checknote}, - {"checkscreen", (caddr_t)checkscreen}, - {"checkpi", (caddr_t)checkpi}, - {"checksi", (caddr_t)checksi}, - {"client_ret", (caddr_t)client_ret}, - {"closeaccnt", (caddr_t)closeaccnt}, - {"closecarrierd", (caddr_t)closecarrierd}, - {"closedep", (caddr_t)closedep}, - {"closedoa", (caddr_t)closedoa}, - {"closeitem", (caddr_t)closeitem}, - {"closenotes", (caddr_t)closenotes}, - {"closeocc", (caddr_t)closeocc}, - {"closepad", (caddr_t)closepad}, - {"closeph", (caddr_t)closeph}, - {"closeser", (caddr_t)closeser}, - {"closesvw", (caddr_t)closesvw}, - {"closeRestCallback", (caddr_t)closeRestCallback}, - {"closeWinCallback", (caddr_t)closeWinCallback}, - {"closew", (caddr_t)closew}, - {"cnacustcd", (caddr_t)cnacustcd}, - {"collectdcback", (caddr_t)collectdcback}, - {"collections", (caddr_t)collections}, - {"crtranhead", (caddr_t)crtranhead}, - {"crcb", (caddr_t)crcb}, - {"crdataval", (caddr_t)crdataval}, - {"crds", (caddr_t)crds}, - {"createed", (caddr_t)createed}, - {"createrb", (caddr_t)createrb}, - {"createwind", (caddr_t)createwind}, - {"crhistnode", (caddr_t)crhistnode}, - {"crlp", (caddr_t)crlp}, - {"crpb", (caddr_t)crpb}, - {"crpe", (caddr_t)crpe}, - {"crrb", (caddr_t)crrb}, - {"crsr", (caddr_t)crsr}, - {"crsw", (caddr_t)crsw}, - {"crtask", (caddr_t)crtask}, - {"crtb", (caddr_t)crtb}, - {"crte", (caddr_t)crte}, - {"curnames", (caddr_t)curnames}, - {"curwinds", (caddr_t)curwinds}, - {"dad_list", (caddr_t)dad_list}, - {"deposits", (caddr_t)deposits}, - {"displabel", (caddr_t)displabel}, - {"downent", (caddr_t)downent}, - {"downent9", (caddr_t)downent9}, - {"downent10", (caddr_t)downent10}, - {"erasepad", (caddr_t)erasepad}, - {"exitsr", (caddr_t)exitsr}, - {"extractinfo", (caddr_t)extractinfo}, - {"findtranhead", (caddr_t)findtranhead}, - {"fix_buttons", (caddr_t)fix_buttons}, - {"freesi", (caddr_t)freesi}, - {"freetext", (caddr_t)freetext}, - {"getcuscode", (caddr_t)getcuscode}, - {"getdataval", (caddr_t)getdataval}, - {"getdupt", (caddr_t)getdupt}, - {"getent", (caddr_t)getent}, - {"getinputstring", (caddr_t)getinputstring}, - {"getnames", (caddr_t)getnames}, - {"getph", (caddr_t)getph}, - {"getrealval", (caddr_t)getrealval}, - {"getreftype", (caddr_t)getreftype}, - {"gettar", (caddr_t)gettar}, - {"gettext", (caddr_t)gettext}, - {"getvalue", (caddr_t)getvalue}, - {"gotoitem", (caddr_t)gotoitem}, - {"helpindex", (caddr_t)helpindex}, - {"helpnames", (caddr_t)helpnames}, - {"initdicts", (caddr_t)initdicts}, - {"initentities", (caddr_t)initentities}, - {"initscr", (caddr_t)initscr}, - {"initwind", (caddr_t)initwind}, - {"itemcarrier", (caddr_t)itemcarrier}, - {"lineitem", (caddr_t)lineitem}, - {"listrefs", (caddr_t)listrefs}, - {"list_deposit", (caddr_t)list_deposit}, - {"load_cust_cred", (caddr_t)load_cust_cred}, - {"loaddata", (caddr_t)loaddata}, - {"loadpsw", (caddr_t)loadpsw}, - {"lud_list", (caddr_t)lud_list}, - {"main", (caddr_t)main}, - {"makedatatag", (caddr_t)makedatatag}, - {"makeentity", (caddr_t)makeentity}, - {"manipulate_spa", (caddr_t)manipulate_spa}, - {"mkref", (caddr_t)mkref}, - {"modverify", (caddr_t)modverify}, - {"municarrier", (caddr_t)municarrier}, - {"natmodes", (caddr_t)natmodes}, - {"nextcarrier", (caddr_t)nextcarrier}, - {"nextcsr", (caddr_t)nextcsr}, - {"nextfunc", (caddr_t)nextfunc}, - {"nexthelp", (caddr_t)nexthelp}, - {"nextserfunc", (caddr_t)nextserfunc}, - {"nexttext", (caddr_t)nexttext}, - {"nextwinds", (caddr_t)nextwinds}, - {"no_close_halt", (caddr_t)no_close_halt}, - {"nodata", (caddr_t)nodata}, - {"note", (caddr_t)note}, - {"notescback", (caddr_t)notescback}, - {"occcarrier", (caddr_t)occcarrier}, - {"ocd_list", (caddr_t)ocd_list}, - {"order", (caddr_t)order}, - {"padjcarrier", (caddr_t)padjcarrier}, - {"phonecna", (caddr_t)phonecna}, - {"phonenum", (caddr_t)phonenum}, - {"piupdate", (caddr_t)piupdate}, - {"prevcarrier", (caddr_t)prevcarrier}, - {"prevcsr", (caddr_t)prevcsr}, - {"prevhelp", (caddr_t)prevhelp}, - {"prevtext", (caddr_t)prevtext}, - {"prevwinds", (caddr_t)prevwinds}, - {"putval", (caddr_t)putval}, - {"quitiws", (caddr_t)quitiws}, - {"raisenative", (caddr_t)raisenative}, - {"raisewind", (caddr_t)raisewind}, - {"refund", (caddr_t)refund}, - {"relayer", (caddr_t)relayer}, - {"rewindtext", (caddr_t)rewindtext}, - {"rmtasks", (caddr_t)rmtasks}, - {"screendisplay", (caddr_t)screendisplay}, - {"searchcur", (caddr_t)searchcur}, - {"searchhelp", (caddr_t)searchhelp}, - {"sendlabel", (caddr_t)sendlabel}, - {"sendphone", (caddr_t)sendphone}, - {"sendphtoBOSS", (caddr_t)sendphtoBOSS}, - {"sendphtofilesvr", (caddr_t)sendphtofilesvr}, - {"sendreq", (caddr_t)sendreq}, - {"sendscreen", (caddr_t)sendscreen}, - {"send_refund", (caddr_t)send_refund}, - {"servcarrier", (caddr_t)servcarrier}, - {"servdcback", (caddr_t)servdcback}, - {"setbutton", (caddr_t)setbutton}, - {"setcuscode", (caddr_t)setcuscode}, - {"setnatsys", (caddr_t)setnatsys}, - {"showsel", (caddr_t)showsel}, - {"siupdate", (caddr_t)siupdate}, - {"sr01load", (caddr_t)sr01load}, - {"sr02load", (caddr_t)sr02load}, - {"sr05load", (caddr_t)sr05load}, - {"sr16carrier", (caddr_t)sr16carrier}, - {"taxcarrier", (caddr_t)taxcarrier}, - {"tcnv", (caddr_t)tcnv}, - {"textdcback", (caddr_t)textdcback}, - {"textptrinit", (caddr_t)textptrinit}, - {"textvalinit", (caddr_t)textvalinit}, - {"tranfeat", (caddr_t)tranfeat}, - {"updatecback", (caddr_t)updatecback}, - {"updatenote", (caddr_t)updatenote}, - {"upddshdhist", (caddr_t)upddshdhist}, - {"updtrthist", (caddr_t)updtrthist}, - {"upent", (caddr_t)upent}, - {"upent9", (caddr_t)upent9}, - {"upent10", (caddr_t)upent10}, - {"usoctran", (caddr_t)usoctran}, - {"validnumber", (caddr_t)validnumber}, - {"varsican", (caddr_t)varsican}, - {"varsiup", (caddr_t)varsiup}, - {"windraise", (caddr_t)windraise}, - {"END", (caddr_t)NULL} -@ - - -20301.13 -log -@CR#7192:M: Worked on treatment -@ -text -@d24 3 -d230 1 -d264 1 -d348 1 -@ - - -20301.12 -log -@CR#7192:M: Worked on Treatment -@ -text -@d24 3 -d201 2 -d211 1 -@ - - -20301.11 -log -@CR#7169:M: Added Treatment functionality -@ -text -@d24 3 -d175 1 -d217 1 -@ - - -20301.10 -log -@CR#7187:M: added cpal functions. -@ -text -@d24 3 -d227 1 -@ - - -20301.9 -log -@CR#7175:M:added lista-deposit & send_refund -@ -text -@d24 3 -d172 1 -d238 1 -d250 1 -d353 1 -@ - - -20301.8 -log -@CR#7170:M:Temporary check-in of QTFU work in progress -@ -text -@d24 3 -d318 1 -d369 1 -@ - - -20301.7 -log -@CR#7187:M: added cpal loading fctn. -@ -text -@d24 3 -d198 1 -d202 1 -@ - - -20301.6 -log -@CR#8227:M:added getreftype -@ -text -@d24 3 -d162 1 -d278 3 -d381 3 -@ - - -20301.5 -log -@CR#7182:M:Added function to close all UBIC associated windows when UBIC -detail is closed -@ -text -@d24 4 -d289 1 -@ - - -20301.4 -log -@CR#7182:M:Add UBIC detail processing -@ -text -@d24 3 -d154 1 -@ - - -20301.3 -log -@CR#7180:M: added ocd_list. -@ -text -@d24 3 -a150 1 - {"DS", (caddr_t)DS}, -d152 1 -d154 1 -d186 1 -d204 1 -@ - - -20301.2 -log -@CR#7169:M: Worked on TRFU -@ -text -@d24 3 -d311 1 -@ - - -20301.1 -log -@CR#7169:M: Worked on TRFU Request -@ -text -@d24 3 -d164 1 -d169 1 -d175 1 -d192 2 -@ - - -20201.38 -log -@CR#8102:M:Added functions for UBIC Summary -@ -text -@d24 3 -d140 1 -d174 1 -@ - - -20201.37 -log -@CR#7977:M: Fixed Entrance window workings -@ -text -@d24 3 -d169 1 -d174 1 -@ - - -20201.36 -log -@CR#7180:M:added sr16 data loading functions. -@ -text -@d24 3 -d141 1 -@ - - -20201.35 -log -@CR#7843:M:Remove unneeded SetupDataForCLSA -@ -text -@d24 3 -d133 2 -d137 1 -a138 1 - {"GenericImage", (caddr_t)GenericImage}, -d146 1 -d150 1 -d199 1 -d232 1 -@ - - -20201.34 -log -@CR#7843:M:stage build for CGI integration -@ -text -@d24 3 -a155 1 - {"SetupDataForCLSA", (caddr_t)SetupDataForCLSA}, -@ - - -20201.33 -log -@CR#7977:M: Worked on SetDataFields -@ -text -@d24 3 -a130 1 - {"GetSaSR07", (caddr_t)GetSaSR07}, -d152 2 -@ - - -20201.32 -log -@CR#7180:M:uncommented Tsuminfo -@ -text -@d24 3 -d150 1 -a150 1 - {"SetDataField", (caddr_t)SetDataField}, -a300 1 - {"setdata", (caddr_t)setdata}, -@ - - -20201.31 -log -@CR#7843:M:Added RaiseCLSA & GetSaSR07 for CLSA Integration, commented TsumInfo -out since it was not defined. -@ -text -@d24 4 -d156 1 -a156 1 -/* {"TsumInfo", (caddr_t)TsumInfo},*/ -@ - - -20201.30 -log -@added TsumInfo -@ -text -@d24 3 -d121 1 -d142 1 -d152 1 -a152 1 - {"TsumInfo", (caddr_t)TsumInfo}, -@ - - -20201.29 -log -@CR#7977:M: Worked on transaction aliasing -@ -text -@d24 3 -d147 1 -@ - - -20201.28 -log -@CR#7717:M: Added collectdcback -@ -text -@d24 3 -a112 1 - {"Error", (caddr_t)Error}, -a151 3 - {"binaryfind", (caddr_t)binaryfind}, - {"buildsrc", (caddr_t)buildsrc}, - {"buildtd", (caddr_t)buildtd}, -a185 1 - {"createdata", (caddr_t)createdata}, -a201 1 - {"ddcheck", (caddr_t)ddcheck}, -d225 1 -a225 1 - {"initdata", (caddr_t)initdata}, -a234 1 - {"loadtd", (caddr_t)loadtd}, -@ - - -20201.27 -log -@CR#7717:M: Fixed lots of stuff -@ -text -@d24 3 -d182 1 -@ - - -20201.26 -log -@added collections. -@ -text -@d24 3 -d127 1 -d140 1 -@ - - -20201.25 -log -@CR#7717:M: Fixed enter and leave handlers -@ -text -@d24 3 -d174 1 -@ - - -20201.24 -log -@CR#7717:M: Removed curform global and enterform() and leaveform() -@ -text -@d24 3 -d100 1 -d111 1 -a193 1 - {"enterTE", (caddr_t)enterTE}, -a219 1 - {"leaveTE", (caddr_t)leaveTE}, -@ - - -20201.23 -log -@CR#7717:M: Worked on fonts and pixmaps -@ -text -@d24 3 -a189 1 - {"enterform", (caddr_t)enterform}, -a216 1 - {"leaveform", (caddr_t)leaveform}, -@ - - -20201.22 -log -@CR#7181:M: added sr16carrier -@ -text -@d24 1 -a24 1 - * Revision 20201.21 90/09/25 13:05:13 13:05:13 greg ( Greg DeMent) -d97 1 -a97 1 - {"HashGetFont", (caddr_t)HashGetFont}, -@ - - -20201.21 -log -@CR#7717:M: Worked on font loading -@ -text -@d24 3 -d279 1 -@ - - -20201.20 -log -@CR#7180:M: added GenericImage for SR16 processing. -@ -text -@d24 3 -d94 1 -@ - - -20201.19 -log -@CR#7581:M: added closeRestCallback() -@ -text -@d24 3 -d90 1 -@ - - -20201.18 -log -@CR#7717:M:Added scrolled window functions -@ -text -@d24 3 -d148 1 -@ - - -20201.17 -log -@CR#7581:M: removed dispserpg, prevser, nextser, and servinfo. -@ -text -@d3 3 -a5 3 -* CONFIDENTIAL -* Disclose And Distribute Solely To Employees Of -* U S WEST And It's Affiliates Having A Need To Know. -d9 2 -a10 2 -* (c)Copyright 1990, U S WEST Information Technologies Group -* All Rights Reserved -d24 3 -d56 1 -a56 1 -* THIS CODE HAS NOT BEEN MADE TO COMPLY WITH NEW STANDARDS ! -a61 1 - -d73 1 -a73 3 - - -Tabfunc functable[] = -d75 205 -a279 205 - {"BOSSDateEffctv", (caddr_t)BOSSDateEffctv}, - {"CB", (caddr_t)CB}, - {"CBED", (caddr_t)CBED}, - {"CSRData", (caddr_t)CSRData}, - {"ClearEnd", (caddr_t)ClearEnd}, - {"DS", (caddr_t)DS}, - {"Deposits", (caddr_t)Deposits}, - {"Error", (caddr_t)Error}, - {"IdEnttySmmry", (caddr_t)IdEnttySmmry}, - {"InfoPrntImg", (caddr_t)InfoPrntImg}, - {"InfoPrntImge", (caddr_t)InfoPrntImge}, - {"InsertToggle", (caddr_t)InsertToggle}, - {"LP", (caddr_t)LP}, - {"LPED", (caddr_t)LPED}, - {"MoveNextEditor", (caddr_t)MoveNextEditor}, - {"MovePreviousEditor", (caddr_t)MovePreviousEditor}, - {"OTCDiscChrg", (caddr_t)OTCDiscChrg}, - {"OTCDiscCodes", (caddr_t)OTCDiscCodes}, - {"OTCDscrtnryAr", (caddr_t)OTCDscrtnryAr}, - {"PB", (caddr_t)PB}, - {"PBED", (caddr_t)PBED}, - {"PE", (caddr_t)PE}, - {"PEED", (caddr_t)PEED}, - {"RB", (caddr_t)RB}, - {"RBED", (caddr_t)RBED}, - {"SetDataField", (caddr_t)SetDataField}, - {"SR", (caddr_t)SR}, - {"SRED", (caddr_t)SRED}, - {"SW", (caddr_t)SW}, - {"SWED", (caddr_t)SWED}, - {"TB", (caddr_t)TB}, - {"TBED", (caddr_t)TBED}, - {"TE", (caddr_t)TE}, - {"TEED", (caddr_t)TEED}, - {"TtlsEnttySmmry", (caddr_t)TtlsEnttySmmry}, - {"activate", (caddr_t)activate}, - {"addlcarrier", (caddr_t)addlcarrier}, - {"adjustitem", (caddr_t)adjustitem}, - {"adlitem", (caddr_t)adlitem}, - {"allocmem", (caddr_t)allocmem}, - {"billcarrier", (caddr_t)billcarrier}, - {"binaryfind", (caddr_t)binaryfind}, - {"buildsrc", (caddr_t)buildsrc}, - {"buildtd", (caddr_t)buildtd}, - {"cancelallrefs", (caddr_t)cancelallrefs}, - {"candshdhist", (caddr_t)candshdhist}, - {"canref", (caddr_t)canref}, - {"cansi", (caddr_t)cansi}, - {"cantrthist", (caddr_t)cantrthist}, - {"carrierlst", (caddr_t)carrierlst}, - {"cartask", (caddr_t)cartask}, - {"carvals", (caddr_t)carvals}, - {"checkdb", (caddr_t)checkdb}, - {"checkentinfo", (caddr_t)checkentinfo}, - {"checkind", (caddr_t)checkind}, - {"checknote", (caddr_t)checknote}, - {"checkscreen", (caddr_t)checkscreen}, - {"checksi", (caddr_t)checksi}, - {"client_ret", (caddr_t)client_ret}, - {"closeaccnt", (caddr_t)closeaccnt}, - {"closecarrierd", (caddr_t)closecarrierd}, - {"closedep", (caddr_t)closedep}, - {"closeitem", (caddr_t)closeitem}, - {"closenotes", (caddr_t)closenotes}, - {"closeocc", (caddr_t)closeocc}, - {"closepad", (caddr_t)closepad}, - {"closeph", (caddr_t)closeph}, - {"closeser", (caddr_t)closeser}, - {"closesvw", (caddr_t)closesvw}, - {"closeWinCallback", (caddr_t)closeWinCallback}, - {"closew", (caddr_t)closew}, - {"cnacustcd", (caddr_t)cnacustcd}, - {"crtranhead", (caddr_t)crtranhead}, - {"crcb", (caddr_t)crcb}, - {"crdataval", (caddr_t)crdataval}, - {"createdata", (caddr_t)createdata}, - {"createds", (caddr_t)createds}, - {"createed", (caddr_t)createed}, - {"createrb", (caddr_t)createrb}, - {"createwind", (caddr_t)createwind}, - {"crhistnode", (caddr_t)crhistnode}, - {"crlp", (caddr_t)crlp}, - {"crpb", (caddr_t)crpb}, - {"crpe", (caddr_t)crpe}, - {"crrb", (caddr_t)crrb}, - {"crsr", (caddr_t)crsr}, - {"crsw", (caddr_t)crsw}, - {"crtask", (caddr_t)crtask}, - {"crtb", (caddr_t)crtb}, - {"crte", (caddr_t)crte}, - {"curnames", (caddr_t)curnames}, - {"curwinds", (caddr_t)curwinds}, - {"ddcheck", (caddr_t)ddcheck}, - {"deposits", (caddr_t)deposits}, - {"displabel", (caddr_t)displabel}, - {"enterTE", (caddr_t)enterTE}, - {"enterform", (caddr_t)enterform}, - {"erasepad", (caddr_t)erasepad}, - {"exitsr", (caddr_t)exitsr}, - {"extractinfo", (caddr_t)extractinfo}, - {"findtranhead", (caddr_t)findtranhead}, - {"fix_buttons", (caddr_t)fix_buttons}, - {"freesi", (caddr_t)freesi}, - {"freetext", (caddr_t)freetext}, - {"getcuscode", (caddr_t)getcuscode}, - {"getdataval", (caddr_t)getdataval}, - {"getdupt", (caddr_t)getdupt}, - {"getent", (caddr_t)getent}, - {"getinputstring", (caddr_t)getinputstring}, - {"getnames", (caddr_t)getnames}, - {"getph", (caddr_t)getph}, - {"getrealval", (caddr_t)getrealval}, - {"gettar", (caddr_t)gettar}, - {"gettext", (caddr_t)gettext}, - {"getvalue", (caddr_t)getvalue}, - {"gotoitem", (caddr_t)gotoitem}, - {"helpindex", (caddr_t)helpindex}, - {"helpnames", (caddr_t)helpnames}, - {"initdata", (caddr_t)initdata}, - {"initentities", (caddr_t)initentities}, - {"initscr", (caddr_t)initscr}, - {"initwind", (caddr_t)initwind}, - {"itemcarrier", (caddr_t)itemcarrier}, - {"leaveTE", (caddr_t)leaveTE}, - {"leaveform", (caddr_t)leaveform}, - {"lineitem", (caddr_t)lineitem}, - {"listrefs", (caddr_t)listrefs}, - {"load_cust_cred", (caddr_t)load_cust_cred}, - {"loaddata", (caddr_t)loaddata}, - {"loadpsw", (caddr_t)loadpsw}, - {"loadtd", (caddr_t)loadtd}, - {"main", (caddr_t)main}, - {"makedatatag", (caddr_t)makedatatag}, - {"makeentity", (caddr_t)makeentity}, - {"manipulate_spa", (caddr_t)manipulate_spa}, - {"mkref", (caddr_t)mkref}, - {"modverify", (caddr_t)modverify}, - {"municarrier", (caddr_t)municarrier}, - {"natmodes", (caddr_t)natmodes}, - {"nextcarrier", (caddr_t)nextcarrier}, - {"nextcsr", (caddr_t)nextcsr}, - {"nextfunc", (caddr_t)nextfunc}, - {"nexthelp", (caddr_t)nexthelp}, - {"nextserfunc", (caddr_t)nextserfunc}, - {"nexttext", (caddr_t)nexttext}, - {"nextwinds", (caddr_t)nextwinds}, - {"no_close_halt", (caddr_t)no_close_halt}, - {"nodata", (caddr_t)nodata}, - {"note", (caddr_t)note}, - {"notescback", (caddr_t)notescback}, - {"occcarrier", (caddr_t)occcarrier}, - {"order", (caddr_t)order}, - {"padjcarrier", (caddr_t)padjcarrier}, - {"phonecna", (caddr_t)phonecna}, - {"phonenum", (caddr_t)phonenum}, - {"prevcarrier", (caddr_t)prevcarrier}, - {"prevcsr", (caddr_t)prevcsr}, - {"prevhelp", (caddr_t)prevhelp}, - {"prevtext", (caddr_t)prevtext}, - {"prevwinds", (caddr_t)prevwinds}, - {"putval", (caddr_t)putval}, - {"quitiws", (caddr_t)quitiws}, - {"raisenative", (caddr_t)raisenative}, - {"raisewind", (caddr_t)raisewind}, - {"refund", (caddr_t)refund}, - {"relayer", (caddr_t)relayer}, - {"rewindtext", (caddr_t)rewindtext}, - {"rmprevwind", (caddr_t)rmprevwind}, - {"rmtasks", (caddr_t)rmtasks}, - {"screendisplay", (caddr_t)screendisplay}, - {"searchcur", (caddr_t)searchcur}, - {"searchhelp", (caddr_t)searchhelp}, - {"sendlabel", (caddr_t)sendlabel}, - {"sendphone", (caddr_t)sendphone}, - {"sendphtoBOSS", (caddr_t)sendphtoBOSS}, - {"sendphtofilesvr", (caddr_t)sendphtofilesvr}, - {"sendreq", (caddr_t)sendreq}, - {"sendscreen", (caddr_t)sendscreen}, - {"servcarrier", (caddr_t)servcarrier}, - {"servdcback", (caddr_t)servdcback}, - {"setbutton", (caddr_t)setbutton}, - {"setcuscode", (caddr_t)setcuscode}, - {"setdata", (caddr_t)setdata}, - {"setnatsys", (caddr_t)setnatsys}, - {"showsel", (caddr_t)showsel}, - {"siupdate", (caddr_t)siupdate}, - {"sr01load", (caddr_t)sr01load}, - {"sr02load", (caddr_t)sr02load}, - {"sr05load", (caddr_t)sr05load}, - {"taxcarrier", (caddr_t)taxcarrier}, - {"tcnv", (caddr_t)tcnv}, - {"textdcback", (caddr_t)textdcback}, - {"textptrinit", (caddr_t)textptrinit}, - {"textvalinit", (caddr_t)textvalinit}, - {"tranfeat", (caddr_t)tranfeat}, - {"updatecback", (caddr_t)updatecback}, - {"updatenote", (caddr_t)updatenote}, - {"upddshdhist", (caddr_t)upddshdhist}, - {"updtrthist", (caddr_t)updtrthist}, - {"usoctran", (caddr_t)usoctran}, - {"validnumber", (caddr_t)validnumber}, - {"varsican", (caddr_t)varsican}, - {"varsiup", (caddr_t)varsiup}, - {"windraise", (caddr_t)windraise}, - {"END", (caddr_t)NULL} -@ - - -20201.16 -log -@CR#7581:M:Change noexit() to closeWinCallback() so name will reflect -wider usage by dialogs -@ -text -@d24 4 -a169 1 - {"dispserpg", (caddr_t)dispserpg}, -a217 1 - {"nextser", (caddr_t)nextser}, -a232 1 - {"prevser", (caddr_t)prevser}, -a254 1 - {"servinfo", (caddr_t)servinfo}, -@ - - -20201.15 -log -@CR#7581:M: deleted serinit and service funtions. -@ -text -@d24 3 -d140 1 -a220 1 - {"noexit", (caddr_t)noexit}, -@ - - -20201.14 -log -@CR#7581:M: removed serheadings -@ -text -@d24 3 -a248 1 - {"serinit", (caddr_t)serinit}, -a250 1 - {"service", (caddr_t)service}, -@ - - -20201.13 -log -@CR#7581:M:Remove Ref Mgr at the Motif port level -@ -text -@d24 3 -a245 1 - {"serheadings", (caddr_t)serheadings}, -@ - - -20201.12 -log -@CR#7581:M:Added new translations for cursor movement with text edits -@ -text -@d24 3 -a86 1 - {"RemoveRefEntity", (caddr_t)RemoveRefEntity}, -a97 3 - {"add_file_to_list", (caddr_t)add_file_to_list}, - {"add_new_sections", (caddr_t)add_new_sections}, - {"add_paperclip_to_list", (caddr_t)add_paperclip_to_list}, -a103 2 - {"build_file_page_index", (caddr_t)build_file_page_index}, - {"build_sec_notes", (caddr_t)build_sec_notes}, -a106 1 - {"cancel_paperclip", (caddr_t)cancel_paperclip}, -a113 3 - {"changefont", (caddr_t)changefont}, - {"check_concurrent_update", (caddr_t)check_concurrent_update}, - {"check_for_note", (caddr_t)check_for_note}, -a119 2 - {"clean_up_section", (caddr_t)clean_up_section}, - {"cleanup_deleted_sections", (caddr_t)cleanup_deleted_sections}, -a120 1 - {"close_note_and_pc_win", (caddr_t)close_note_and_pc_win}, -a132 4 - {"comp", (caddr_t)comp}, - {"cont_update_notes", (caddr_t)cont_update_notes}, - {"cont_update_pc", (caddr_t)cont_update_pc}, - {"cpfile", (caddr_t)cpfile}, -a135 3 - {"create_admin_lists", (caddr_t)create_admin_lists}, - {"create_user_dir", (caddr_t)create_user_dir}, - {"create_user_lists", (caddr_t)create_user_lists}, -a153 4 - {"decide_menu", (caddr_t)decide_menu}, - {"del_outdated_pc", (caddr_t)del_outdated_pc}, - {"delete_note", (caddr_t)delete_note}, - {"delete_paperclip", (caddr_t)delete_paperclip}, -a155 2 - {"display_data_to_screen", (caddr_t)display_data_to_screen}, - {"display_search_pg_to_screen", (caddr_t)display_search_pg_to_screen}, -a160 3 - {"extract_section", (caddr_t)extract_section}, - {"extract_update_pc", (caddr_t)extract_update_pc}, - {"extract_update_sec", (caddr_t)extract_update_sec}, -a161 2 - {"find_outdated_paperclps", (caddr_t)find_outdated_paperclps}, - {"find_str", (caddr_t)find_str}, -a163 1 - {"free_user_adm_lists", (caddr_t)free_usr_adm_lists}, -a165 10 - {"get_ava_sec_entity", (caddr_t)get_ava_sec_entity}, - {"get_entity", (caddr_t)get_entity}, - {"get_file_pg_offset", (caddr_t)get_file_pg_offset}, - {"get_max_char", (caddr_t)get_max_char}, - {"get_max_line", (caddr_t)get_max_line}, - {"get_node_ptr", (caddr_t)get_node_ptr}, - {"get_sec_alpha_entity", (caddr_t)get_sec_alpha_entity}, - {"get_sec_index", (caddr_t)get_sec_index}, - {"get_te_string", (caddr_t)get_te_string}, - {"get_total_pages", (caddr_t)get_total_pages}, -a176 1 - {"gotoindex", (caddr_t)gotoindex}, -a177 2 - {"gotopage", (caddr_t)gotopage}, - {"handbook", (caddr_t)handbook}, -a183 4 - {"insert_alpha_numeric", (caddr_t)insert_alpha_numeric}, - {"insert_lead_alpha_numeric", (caddr_t)insert_lead_alpha_numeric}, - {"insert_numeric", (caddr_t)insert_numeric}, - {"is_number", (caddr_t)is_number}, -a185 1 - {"leave_note", (caddr_t)leave_note}, -a189 4 - {"load_paperclip_file", (caddr_t)load_paperclip_file}, - {"load_paperclips", (caddr_t)load_paperclips}, - {"load_sections", (caddr_t)load_sections}, - {"load_updated_sections", (caddr_t)load_updated_sections}, -a192 3 - {"log_pc", (caddr_t)log_pc}, - {"log_sec", (caddr_t)log_sec}, - {"look_up_page", (caddr_t)look_up_page}, -a198 1 - {"move_note_to", (caddr_t)move_note_to}, -a200 3 - {"new_log_item", (caddr_t)new_log_item}, - {"new_user", (caddr_t)new_user}, - {"next", (caddr_t)next}, -a208 1 - {"no_change", (caddr_t)no_change}, -a213 2 - {"note_exists", (caddr_t)note_exists}, - {"notes_in_section", (caddr_t)notes_in_section}, -a214 1 - {"odd_page", (caddr_t)odd_page}, -a215 1 - {"outdated_paperclips", (caddr_t)outdated_paperclips}, -a216 1 - {"paperclip", (caddr_t)paperclip}, -a218 4 - {"place_date_node", (caddr_t)place_date_node}, - {"place_note_node", (caddr_t)place_note_node}, - {"prepare_hb_screen", (caddr_t)prepare_hb_screen}, - {"prev", (caddr_t)prev}, -a228 7 - {"read_file_into_index", (caddr_t)read_file_into_index}, - {"ref_abend", (caddr_t)ref_abend}, - {"ref_close_window", (caddr_t)ref_close_window}, - {"ref_update_pc", (caddr_t)ref_update_pc}, - {"ref_update_stop", (caddr_t)ref_update_stop}, - {"ref_update_win_list", (caddr_t)ref_update_win_list}, - {"refresh_updt_pc_screen", (caddr_t)refresh_updt_pc_screen}, -a230 5 - {"relocate_delete_note", (caddr_t)relocate_delete_note}, - {"relocate_note_exists", (caddr_t)relocate_note_exists}, - {"relocate_note_to", (caddr_t)relocate_note_to}, - {"remove_clip_from_list", (caddr_t)remove_clip_from_list}, - {"removedir", (caddr_t)removedir}, -a231 1 - {"rm_old_paperclip", (caddr_t)rm_old_paperclip}, -a233 2 - {"save_note", (caddr_t)save_note}, - {"save_paperclip", (caddr_t)save_paperclip}, -a234 2 - {"search_dn", (caddr_t)search_dn}, - {"search_up", (caddr_t)search_up}, -a236 2 - {"sec_entity_available", (caddr_t)sec_entity_available}, - {"sec_ind_displayed", (caddr_t)sec_ind_displayed}, -a262 1 - {"too_many_paperclips", (caddr_t)too_many_paperclips}, -a263 7 - {"two_paperclips_one_page", (caddr_t)two_paperclips_one_page}, - {"unique_paperclip_name", (caddr_t)unique_paperclip_name}, - {"update_entity_sec_list", (caddr_t)update_entity_sec_list}, - {"update_notes", (caddr_t)update_notes}, - {"update_paperclips", (caddr_t)update_paperclips}, - {"update_section_notes", (caddr_t)update_section_notes}, - {"update_user_notes_list", (caddr_t)update_user_notes_list}, -a265 1 - {"updates_exist", (caddr_t)updates_exist}, -a268 2 - {"valid_page_number", (caddr_t)valid_page_number}, - {"valid_section", (caddr_t)valid_section}, -a272 2 - {"write_list_to_file", (caddr_t)write_list_to_file}, - {"write_user_notes_file", (caddr_t)write_user_notes_file}, -@ - - -20201.11 -log -@CR#7173:M: Fixed compile problem with get_item_list -@ -text -@d24 3 -d73 1 -@ - - -20201.10 -log -@CR#7173:M: Put in scrolled window stub functions and structures -@ -text -@d24 3 -d81 1 -a81 1 - {"SetDataField", (caddr_t)SetDataField}, -d84 2 -a85 2 - {"SW", (caddr_t)SW}, - {"SWED", (caddr_t)SWED}, -d106 1 -a106 1 - {"cancel_paperclip", (caddr_t)cancel_paperclip}, -a193 1 - {"get_item_list", (caddr_t)get_item_list}, -@ - - -20201.9 -log -@CR#7581:M:Removed accidental redefine of RCSid -@ -text -@d24 3 -d81 2 -d157 1 -@ - - -20201.8 -log -@CR#7581:M:Added SetDataField() -@ -text -@d23 4 -a26 1 -* $Log$ -a31 1 -static char *sRCS_ID_s = "$Header$"; -@ - - -20201.7 -log -@CR#7581:M: -@ -text -@d1 12 -a12 6 -/* @@(#) "*/ -/* @@(#)Copyright U S WEST Information Technologies Group, 1989. "*/ -/* @@(#) "*/ -/* @@(#)Proprietary: Not for use or disclosure outside U S WEST and its "*/ -/* @@(#)affiliates exceptr under written agreement. "*/ -/* @@(#) "*/ -d14 16 -d73 1 -d183 1 -a183 1 - {"get_item_list", (caddr_t)get_item_list}, -@ - - -20201.6 -log -@CR#7581:M:Motif Port -@ -text -@d160 1 -@ - - -20201.5 -log -@Motif Port -@ -text -@a118 1 - {"createicon", (caddr_t)createicon}, -a185 1 - {"initicons", (caddr_t)initicons}, -@ - - -20201.4 -log -@CR#7553:M:Remove Sales Advisor -@ -text -@a52 2 - /* {"ST", (caddr_t)ST},*/ - {"STED", (caddr_t)STED}, -a127 1 - {"crst", (caddr_t)crst}, -@ - - -20201.3 -log -@Motif port. -@ -text -@a64 1 - {"addons", (caddr_t)addons}, -a66 2 - {"akas", (caddr_t)akas}, - {"alalac", (caddr_t)alalac}, -a67 2 - {"alplac", (caddr_t)alplac}, - {"benefits", (caddr_t)benefits}, -a69 1 - {"bndle", (caddr_t)bndle}, -a73 2 - {"callknlg", (caddr_t)callknlg}, - {"caloc", (caddr_t)caloc}, -a106 6 - {"clpit", (caddr_t)clpit}, - {"clz", (caddr_t)clz}, - {"clzbnft", (caddr_t)clzbnft}, - {"clzprfl", (caddr_t)clzprfl}, - {"clzrcmnd", (caddr_t)clzrcmnd}, - {"clzum", (caddr_t)clzum}, -a110 1 - {"cost", (caddr_t)cost}, -a113 1 - {"crcursoc", (caddr_t)crcursoc}, -a128 1 - {"crsaleusoc", (caddr_t)crsaleusoc}, -a133 1 - {"cualoc", (caddr_t)cualoc}, -a135 1 - {"custbenes", (caddr_t)custbenes}, -a141 1 - {"dispbenes", (caddr_t)dispbenes}, -a145 1 - {"dsply", (caddr_t)dsply}, -a153 1 - {"fakeit", (caddr_t)fakeit}, -a157 4 - {"fndit", (caddr_t)fndit}, - {"fnsh", (caddr_t)fnsh}, - {"fre", (caddr_t)fre}, - {"frealac", (caddr_t)frealac}, -a160 1 - {"frmt", (caddr_t)frmt}, -a170 2 - {"getall", (caddr_t)getall}, - {"getcr", (caddr_t)getcr}, -a176 1 - {"getoffice", (caddr_t)getoffice}, -a178 1 - {"getstd", (caddr_t)getstd}, -a180 1 - {"getuscs", (caddr_t)getuscs}, -a184 1 - {"gtit", (caddr_t)gtit}, -a187 1 - {"init", (caddr_t)init}, -a190 1 - {"initsales", (caddr_t)initsales}, -a197 1 - {"ksrspnscr", (caddr_t)ksrspnscr}, -a213 1 - {"lrgr", (caddr_t)lrgr}, -a218 1 - {"mng", (caddr_t)mng}, -a219 1 - {"motset", (caddr_t)motset}, -a221 2 - {"mvit", (caddr_t)mvit}, - {"mxmch", (caddr_t)mxmch}, -a227 1 - {"nextcusts", (caddr_t)nextcusts}, -a241 3 - {"nxtbnprd", (caddr_t)nxtbnprd}, - {"nxtcustpg", (caddr_t)nxtcustpg}, - {"nxtcustscroll", (caddr_t)nxtcustscroll}, -a244 1 - {"out", (caddr_t)out}, -a249 1 - {"pkit", (caddr_t)pkit}, -a251 4 - {"play", (caddr_t)play}, - {"pldwn", (caddr_t)pldwn}, - {"pooaloc", (caddr_t)pooaloc}, - {"prdsort", (caddr_t)prdsort}, -a255 1 - {"prevcusts", (caddr_t)prevcusts}, -a259 6 - {"pricit", (caddr_t)pricit}, - {"prvbnprd", (caddr_t)prvbnprd}, - {"prvcustpg", (caddr_t)prvcustpg}, - {"prvcustscroll", (caddr_t)prvcustscroll}, - {"ptup", (caddr_t)ptup}, - {"pupaloc", (caddr_t)pupaloc}, -a263 1 - {"rankit", (caddr_t)rankit}, -a277 1 - {"rerun", (caddr_t)rerun}, -a281 7 - {"rnctb", (caddr_t)rnctb}, - {"rnitb", (caddr_t)rnitb}, - {"rnmtb", (caddr_t)rnmtb}, - {"rnstb", (caddr_t)rnstb}, - {"safrmt", (caddr_t)safrmt}, - {"sales", (caddr_t)sales}, - {"salesinfo", (caddr_t)salesinfo}, -a305 1 - {"setlnpr", (caddr_t)setlnpr}, -a306 1 - {"shft", (caddr_t)shft}, -a308 1 - {"smlr", (caddr_t)smlr}, -a316 1 - {"tkit", (caddr_t)tkit}, -a336 1 - {"waloc", (caddr_t)waloc}, -a337 1 - {"wldcrd", (caddr_t)wldcrd}, -a339 1 - {"xactm", (caddr_t)xactm}, -@ - - -20201.2 -log -@CR#7188:M:Made Carrier Information work -@ -text -@d53 1 -a53 1 - {"ST", (caddr_t)ST}, -@ - - -20201.1 -log -@CR#7166:M:Made EntityTable load from a file instead of being compiled in -@ -text -@d95 1 -@ - - -20103.1 -log -@CR#7019:M:Add cancel_paperclip() function. -@ -text -@d222 1 -@ - - -20103.1.1.1 -log -@CR#7103:M: -@ -text -@a120 1 - {"collections", (caddr_t)collections}, -@ - - -20103.1.1.1.1.1 -log -@CR#7610:M: Fixed memory leaks -@ -text -@d50 1 -d61 3 -d65 1 -d68 5 -d75 3 -d80 2 -d83 1 -d91 3 -d99 2 -d102 1 -d114 6 -d122 5 -d129 1 -d131 3 -d145 1 -d151 1 -d154 1 -d156 4 -d161 1 -d163 2 -d166 1 -d171 3 -d175 3 -d180 5 -d187 13 -d206 1 -d209 1 -d212 1 -d214 1 -d216 3 -d221 1 -d224 1 -d227 4 -d232 1 -d234 1 -d239 4 -d246 4 -d255 1 -d257 2 -d260 2 -d263 3 -d268 1 -d275 1 -d281 5 -d287 1 -d289 2 -d292 1 -d295 9 -d306 1 -d311 6 -d321 8 -d331 6 -d338 1 -d341 9 -d351 2 -d355 2 -d372 1 -d374 1 -d377 1 -d386 2 -d389 7 -d398 1 -d402 2 -d407 1 -d409 4 -@ - - -20103.1.1.2 -log -@CR#7610:M:Remove Sales Advisor & Ref Mgr code -@ -text -@d50 1 -d61 3 -d65 1 -d68 2 -d71 2 -d75 3 -d80 2 -d83 1 -d91 3 -d99 2 -d102 1 -d114 6 -d122 5 -d129 1 -d131 3 -d145 1 -d151 1 -d154 1 -d156 4 -d161 1 -d163 2 -d166 1 -d171 3 -d175 3 -d180 5 -d187 13 -d206 1 -d209 1 -d212 1 -d214 1 -d216 3 -d221 1 -d224 1 -d227 4 -d232 1 -d234 1 -d239 4 -d246 4 -d255 1 -d257 2 -d260 2 -d263 3 -d268 1 -d275 1 -d281 5 -d287 1 -d289 2 -d292 1 -d295 9 -d306 1 -d311 6 -d321 8 -d331 6 -d338 1 -d341 9 -d351 2 -d355 2 -d372 1 -d374 1 -d377 1 -d386 2 -d389 7 -d398 1 -d402 2 -d407 1 -d409 4 -@ - - -20102.3 -log -@CR#6879:M:Added entries for prevcsr() and nextcsr() -CR#6939:M:Added entries for closenotes() and notescback() -@ -text -@d83 1 -@ - - -20102.2 -log -@Removed the datechk function, which is not used -@ -text -@d106 1 -d265 1 -d278 1 -d303 1 -@ - - -20102.1 -log -@Initial correction of RCS revision numbers -@ -text -@a151 1 - {"datechk", (caddr_t)datechk}, -@ - - -1.5 -log -@CR#6881:M: Fixed SR01 processing partially -@ -text -@@ - - -1.4 -log -@rm phchk, add sr02load, sr05load -@ -text -@d198 1 -@ - - -1.3 -log -@modified to support multiple phone numbers -@ -text -@a287 1 - {"phchk", (caddr_t)phchk}, -d373 2 -@ - - -1.2 -log -@Initial 2.0 release -@ -text -@d124 1 -a124 1 - {"crabi", (caddr_t)crabi}, -d176 1 -a176 1 - {"findscreen", (caddr_t)findscreen}, -@ - - -1.1 -log -@Initial revision -@ -text -@d1 6 -a6 6 -/* @@(#) "*/ -/* @@(#)Copyright U S WEST Information Technologies Group, 1989. "*/ -/* @@(#) "*/ -/* @@(#)Proprietary: Not for use or disclosure outside U S WEST and its "*/ -/* @@(#)affiliates exceptr under written agreement. "*/ -/* @@(#) "*/ -d9 15 -a25 100 - {"getbuttons", (caddr_t)getbuttons}, - {"crdataval", (caddr_t)crdataval}, - {"getent", (caddr_t)getent}, - {"crhistnode", (caddr_t)crhistnode}, - {"get_ava_sec_entity", (caddr_t)get_ava_sec_entity}, - {"get_node_ptr", (caddr_t)get_node_ptr}, - {"gettar", (caddr_t)gettar}, - {"gettext", (caddr_t)gettext}, - {"rewindtext", (caddr_t)rewindtext}, - {"textptrinit", (caddr_t)textptrinit}, - {"crabi", (caddr_t)crabi}, - {"findscreen", (caddr_t)findscreen}, - {"allocmem", (caddr_t)allocmem}, - {"get_search_string", (caddr_t)get_search_string}, - {"getdataval", (caddr_t)getdataval}, - {"getinputstring", (caddr_t)getinputstring}, - {"getrealval", (caddr_t)getrealval}, - {"getvalue", (caddr_t)getvalue}, - {"search", (caddr_t)search}, - {"get_file_pg_offset", (caddr_t)get_file_pg_offset}, - {"get_total_pages", (caddr_t)get_total_pages}, - {"look_up_page", (caddr_t)look_up_page}, - {"add_new_sections", (caddr_t)add_new_sections}, - {"cleanup_deleted_sections", (caddr_t)cleanup_deleted_sections}, - {"addons", (caddr_t)addons}, - {"akas", (caddr_t)akas}, - {"alalac", (caddr_t)alalac}, - {"alplac", (caddr_t)alplac}, - {"bndle", (caddr_t)bndle}, - {"caloc", (caddr_t)caloc}, - {"checkdb", (caddr_t)checkdb}, - {"closeph", (caddr_t)closeph}, - {"clpit", (caddr_t)clpit}, - {"clz", (caddr_t)clz}, - {"comp", (caddr_t)comp}, - {"cualoc", (caddr_t)cualoc}, - {"deposits", (caddr_t)deposits}, - {"dsply", (caddr_t)dsply}, - {"fakeit", (caddr_t)fakeit}, - {"find_str", (caddr_t)find_str}, - {"fndit", (caddr_t)fndit}, - {"fnsh", (caddr_t)fnsh}, - {"fre", (caddr_t)fre}, - {"frealac", (caddr_t)frealac}, - {"frmt", (caddr_t)frmt}, - {"get_numeric_day", (caddr_t)get_numeric_day}, - {"get_numeric_month", (caddr_t)get_numeric_month}, - {"get_numeric_year", (caddr_t)get_numeric_year}, - {"getall", (caddr_t)getall}, - {"getcr", (caddr_t)getcr}, - {"getstd", (caddr_t)getstd}, - {"getuscs", (caddr_t)getuscs}, - {"gtit", (caddr_t)gtit}, - {"helpinfo", (caddr_t)helpinfo}, - {"init", (caddr_t)init}, - {"is_number", (caddr_t)is_number}, - {"loaddata", (caddr_t)loaddata}, - {"main", (caddr_t)main}, - {"makedatatag", (caddr_t)makedatatag}, - {"mvit", (caddr_t)mvit}, - {"mxmch", (caddr_t)mxmch}, - {"new_user", (caddr_t)new_user}, - {"nodata", (caddr_t)nodata}, - {"no_close_halt", (caddr_t)no_close_halt}, - {"note_exists", (caddr_t)note_exists}, - {"notes_in_section", (caddr_t)notes_in_section}, - {"odd_page", (caddr_t)odd_page}, - {"out", (caddr_t)out}, - {"pkit", (caddr_t)pkit}, - {"play", (caddr_t)play}, - {"pldwn", (caddr_t)pldwn}, - {"pooaloc", (caddr_t)pooaloc}, - {"pricit", (caddr_t)pricit}, - {"ptrup", (caddr_t)ptup}, - {"pupaloc", (caddr_t)pupaloc}, - {"putval", (caddr_t)putval}, - {"rankit", (caddr_t)rankit}, - {"relocate_note_exists", (caddr_t)relocate_note_exists}, - {"rerun", (caddr_t)rerun}, - {"rnctb", (caddr_t)rnctb}, - {"rnitb", (caddr_t)rnitb}, - {"rnmtb", (caddr_t)rnmtb}, - {"rnstb", (caddr_t)rnstb}, - {"safrmt", (caddr_t)safrmt}, - {"sales", (caddr_t)sales}, - {"sales", (caddr_t)sales}, - {"sec_entity_available", (caddr_t)sec_entity_available}, - {"sec_ind_displayed", (caddr_t)sec_ind_displayed}, - {"serheadings", (caddr_t)serheadings}, - {"service", (caddr_t)service}, - {"setlnpr", (caddr_t)setlnpr}, - {"shft", (caddr_t)shft}, - {"tkit", (caddr_t)tkit}, - {"update_entity_sec_list", (caddr_t)update_entity_sec_list}, - {"updates_exist", (caddr_t)updates_exist}, - {"valid_page_number", (caddr_t)valid_page_number}, - {"waloc", (caddr_t)waloc}, - {"windfunc", (caddr_t)windfunc}, - {"wldcrd", (caddr_t)wldcrd}, - {"xactm", (caddr_t)xactm}, -d30 1 -a30 1 - {"CodeEnttyID", (caddr_t)CodeEnttyID}, -d37 1 -d40 1 -d61 3 -d65 1 -d68 4 -d74 2 -d78 2 -d81 1 -d91 1 -d93 1 -d97 1 -d99 1 -d101 1 -a101 1 - {"close_note_window", (caddr_t)close_note_window}, -d108 1 -d112 2 -d119 1 -d121 1 -d123 2 -d127 2 -a128 1 - {"create_user_admin_lists", (caddr_t)create_user_admin_lists}, -d130 1 -d137 1 -d148 2 -d153 3 -d157 2 -d164 1 -a165 1 - {"enteract", (caddr_t)enteract}, -d170 1 -d173 9 -a181 1 - {"footnote", (caddr_t)footnote}, -d183 1 -d185 4 -d191 1 -d194 5 -a198 1 - {"get_string", (caddr_t)get_string}, -d200 2 -a201 1 - {"gethelp", (caddr_t)gethelp}, -d205 6 -d214 1 -d217 2 -d221 1 -d227 1 -d236 3 -d240 1 -d242 7 -d252 1 -d254 1 -d257 2 -d260 2 -d265 1 -d268 1 -d272 2 -d276 3 -d282 1 -d284 2 -a285 1 - {"openhelp", (caddr_t)openhelp}, -d287 1 -d291 6 -d306 2 -d310 3 -a312 1 - {"putvarput", (caddr_t)putvarput}, -d314 1 -d316 1 -d320 1 -d323 1 -d325 1 -d327 1 -d329 5 -a333 1 - {"rmactlist", (caddr_t)rmactlist}, -d336 6 -d344 1 -d348 1 -d350 2 -d354 2 -d358 1 -a359 1 - {"serv_ret", (caddr_t)serv_ret}, -d362 1 -d367 1 -d369 1 -d372 1 -a375 1 - {"testsi", (caddr_t)testsi}, -d377 1 -d379 2 -d382 3 -d386 1 -d391 1 -d395 3 -a397 2 - {"varcopytable", (caddr_t)varcopytable}, - {"varputval", (caddr_t)varputval}, -d400 4 -d405 2 -a406 2 - {"windraise", (caddr_t)windraise}, - {"END", (caddr_t)NULL}, -@ diff --git a/global.var b/global.var index 74dcac2a94..13486f72e1 100644 --- a/global.var +++ b/global.var @@ -1,13 +1,20 @@ # Global variables No Sv +Xpv Yes +additem an buf bufend bufptr +check +coeff compiling comppad +comppadname +comppadnamefill +cop_seqmax cryptseen cshlen cshname @@ -20,33 +27,58 @@ egid error_count euid evstr +expect expectterm fold freq gid hexdigit in_format +in_my know_next last_lop last_uni linestr +markstack +markstack_max +markstack_ptr multi_close multi_end multi_open multi_start +na +needblockscope nexttype nextval +no_aelem +no_dir_func +no_func +no_helem +no_mem +no_modify +no_security +no_sock_func +no_usym nointrp nomem nomemok oldbufptr oldoldbufptr +op +op_name +op_seqmax +opargs origalen origenviron padix patleave +ppaddr +rcsid +reall_srchlen +regarglen regbol regcode +regdummy regendp regeol regfold @@ -55,6 +87,7 @@ reglastparen regmyendp regmyp_size regmystartp +regnarrate regnpar regparse regprecomp @@ -65,9 +98,25 @@ regsize regstartp regtill regxend +retstack +retstack_ix +retstack_max rsfp +savestack +savestack_ix +savestack_max saw_return +scopestack +scopestack_ix +scopestack_max +scrgv +sig_name +simple +stack_base +stack_max +stack_sp statbuf +sub_generation subline subname sv_no @@ -77,6 +126,725 @@ thisexpr timesbuf tokenbuf uid +varies vert +vtbl_arylen +vtbl_bm +vtbl_dbline +vtbl_env +vtbl_envelem +vtbl_glob +vtbl_isa +vtbl_isaelem +vtbl_mglob +vtbl_pack +vtbl_packelem +vtbl_sig +vtbl_sigelem +vtbl_substr +vtbl_sv +vtbl_taint +vtbl_uvar +vtbl_vec +warn_nl +warn_nosemi +warn_reserved +watchaddr +watchok +yychar +yycheck +yydebug +yydefred +yydgoto +yyerrflag +yygindex +yylen +yylhs +yylval +yyname +yynerrs +yyrindex +yyrule +yysindex +yytable +yyval # Functions + +append_elem +append_list +apply +av_clear +av_fake +av_fetch +av_fill +av_free +av_len +av_make +av_pop +av_popnulls +av_push +av_shift +av_store +av_undef +av_unshift +bind_match +block_head +calllist +cando +check_uni +checkcomma +ck_aelem +ck_chop +ck_concat +ck_eof +ck_eval +ck_exec +ck_formline +ck_ftst +ck_fun +ck_glob +ck_grep +ck_gvconst +ck_index +ck_lengthconst +ck_lfun +ck_listiob +ck_match +ck_null +ck_repeat +ck_retarget +ck_rvconst +ck_select +ck_shift +ck_sort +ck_split +ck_subr +ck_trunc +convert +cpy7bit +cpytill +croak +cv_clear +cxinc +deb +deb_growlevel +debop +debstack +debstackptrs +die +die_where +do_aexec +do_chop +do_close +do_ctl +do_eof +do_exec +do_execfree +do_ipcctl +do_ipcget +do_join +do_kv +do_msgrcv +do_msgsnd +do_open +do_pipe +do_print +do_readline +do_seek +do_semop +do_shmio +do_sprintf +do_tell +do_trans +do_vecset +do_vop +doeval +dofindlabel +dopoptoeval +dump_all +dump_eval +dump_gv +dump_op +dump_packsubs +dump_pm +dump_sub +fbm_compile +fbm_instr +fetch_gv +fetch_io +fetch_stash +fold_constants +force_ident +force_next +force_word +free_tmps +gen_constant_list +getgimme +gp_free +gp_ref +gv_AVadd +gv_HVadd +gv_check +gv_efullname +gv_fetchfile +gv_fetchmeth +gv_fetchmethod +gv_fetchpv +gv_fullname +gv_init +he_delayfree +he_free +hoistmust +hv_clear +hv_delete +hv_fetch +hv_free +hv_iterinit +hv_iterkey +hv_iternext +hv_iterval +hv_magic +hv_store +hv_undef +ibcmp +ingroup +instr +intuit_more +invert +jmaybe +keyword +leave_scope +lex_end +lex_start +linklist +list +listkids +localize +looks_like_number +magic_clearpack +magic_get +magic_getarylen +magic_getglob +magic_getpack +magic_gettaint +magic_getuvar +magic_len +magic_nextpack +magic_set +magic_setarylen +magic_setbm +magic_setdbline +magic_setenv +magic_setglob +magic_setisa +magic_setmglob +magic_setpack +magic_setsig +magic_setsubstr +magic_settaint +magic_setuvar +magic_setvec +magicname +mess +mg_clear +mg_copy +mg_find +mg_free +mg_get +mg_len +mg_set +mod +modkids +moreswitches +my +my_exit +my_lstat +my_pclose +my_popen +my_setenv +my_stat +my_unexec +newANONHASH +newANONLIST +newASSIGNOP +newAV +newAVREF +newBINOP +newCONDOP +newCVOP +newCVREF +newFORM +newFOROP +newGVOP +newGVREF +newGVgen +newHV +newHVREF +newIO +newLISTOP +newLOGOP +newLOOPOP +newMETHOD +newNULLLIST +newOP +newPMOP +newPVOP +newRANGE +newSLICEOP +newSTATEOP +newSUB +newSV +newSVOP +newSVREF +newSViv +newSVnv +newSVpv +newSVsv +newUNOP +newWHILEOP +newXSUB +nextargv +ninstr +no_fh_allowed +no_op +nsavestr +oopsAV +oopsCV +oopsHV +op_free +package +pad_alloc +pad_allocmy +pad_findmy +pad_free +pad_leavemy +pad_reset +pad_sv +pad_swipe +peep +pidgone +pmruntime +pmtrans +pop_return +pop_scope +pp_aassign +pp_accept +pp_add +pp_aelem +pp_aelemfast +pp_alarm +pp_and +pp_andassign +pp_anonhash +pp_anonlist +pp_aslice +pp_atan2 +pp_av2arylen +pp_backtick +pp_bind +pp_binmode +pp_bit_and +pp_bit_or +pp_bless +pp_caller +pp_chdir +pp_chmod +pp_chop +pp_chown +pp_chroot +pp_close +pp_closedir +pp_complement +pp_concat +pp_cond_expr +pp_connect +pp_const +pp_cos +pp_crypt +pp_cswitch +pp_dbmclose +pp_dbmopen +pp_dbstate +pp_defined +pp_delete +pp_die +pp_divide +pp_dofile +pp_done +pp_dump +pp_each +pp_egrent +pp_ehostent +pp_enetent +pp_enter +pp_entereval +pp_enteriter +pp_enterloop +pp_entersubr +pp_entertry +pp_enterwrite +pp_eof +pp_eprotoent +pp_epwent +pp_eq +pp_eservent +pp_evalonce +pp_exec +pp_exit +pp_exp +pp_fcntl +pp_fileno +pp_flip +pp_flock +pp_flop +pp_fork +pp_formline +pp_ftatime +pp_ftbinary +pp_ftblk +pp_ftchr +pp_ftctime +pp_ftdir +pp_fteexec +pp_fteowned +pp_fteread +pp_ftewrite +pp_ftfile +pp_ftis +pp_ftlink +pp_ftmtime +pp_ftpipe +pp_ftrexec +pp_ftrowned +pp_ftrread +pp_ftrwrite +pp_ftsgid +pp_ftsize +pp_ftsock +pp_ftsuid +pp_ftsvtx +pp_fttext +pp_fttty +pp_ftzero +pp_ge +pp_getc +pp_getlogin +pp_getpeername +pp_getpgrp +pp_getppid +pp_getpriority +pp_getsockname +pp_ggrent +pp_ggrgid +pp_ggrnam +pp_ghbyaddr +pp_ghbyname +pp_ghostent +pp_glob +pp_gmtime +pp_gnbyaddr +pp_gnbyname +pp_gnetent +pp_goto +pp_gpbyname +pp_gpbynumber +pp_gprotoent +pp_gpwent +pp_gpwnam +pp_gpwuid +pp_grepstart +pp_grepwhile +pp_gsbyname +pp_gsbyport +pp_gservent +pp_gsockopt +pp_gt +pp_gv +pp_gvsv +pp_helem +pp_hex +pp_hslice +pp_index +pp_indread +pp_int +pp_intadd +pp_interp +pp_ioctl +pp_iter +pp_join +pp_keys +pp_kill +pp_last +pp_lc +pp_lcfirst +pp_le +pp_leave +pp_leaveeval +pp_leaveloop +pp_leavesubr +pp_leavetry +pp_leavewrite +pp_left_shift +pp_length +pp_lineseq +pp_link +pp_list +pp_listen +pp_localtime +pp_log +pp_lslice +pp_lstat +pp_lt +pp_match +pp_method +pp_mkdir +pp_modulo +pp_msgctl +pp_msgget +pp_msgrcv +pp_msgsnd +pp_multiply +pp_ncmp +pp_ne +pp_negate +pp_next +pp_nextstate +pp_not +pp_nswitch +pp_null +pp_oct +pp_open +pp_open_dir +pp_or +pp_orassign +pp_ord +pp_pack +pp_padav +pp_padhv +pp_padsv +pp_pipe_op +pp_pop +pp_postdec +pp_postinc +pp_pow +pp_predec +pp_preinc +pp_print +pp_prtf +pp_push +pp_pushmark +pp_pushre +pp_rand +pp_range +pp_rcatline +pp_read +pp_readdir +pp_readline +pp_readlink +pp_recv +pp_redo +pp_ref +pp_refgen +pp_regcmaybe +pp_regcomp +pp_rename +pp_repeat +pp_require +pp_reset +pp_return +pp_reverse +pp_rewinddir +pp_right_shift +pp_rindex +pp_rmdir +pp_rv2av +pp_rv2cv +pp_rv2gv +pp_rv2hv +pp_rv2sv +pp_sassign +pp_scalar +pp_schop +pp_scmp +pp_scope +pp_seek +pp_seekdir +pp_select +pp_semctl +pp_semget +pp_semop +pp_send +pp_seq +pp_setpgrp +pp_setpriority +pp_sge +pp_sgrent +pp_sgt +pp_shift +pp_shmctl +pp_shmget +pp_shmread +pp_shmwrite +pp_shostent +pp_shutdown +pp_sin +pp_sle +pp_sleep +pp_slt +pp_sne +pp_snetent +pp_socket +pp_sockpair +pp_sort +pp_splice +pp_split +pp_sprintf +pp_sprotoent +pp_spwent +pp_sqrt +pp_srand +pp_sselect +pp_sservent +pp_ssockopt +pp_stat +pp_stub +pp_study +pp_subst +pp_substcont +pp_substr +pp_subtract +pp_sv2len +pp_symlink +pp_syscall +pp_sysread +pp_system +pp_syswrite +pp_tell +pp_telldir +pp_tie +pp_time +pp_tms +pp_trans +pp_truncate +pp_uc +pp_ucfirst +pp_umask +pp_undef +pp_unlink +pp_unpack +pp_unshift +pp_unstack +pp_untie +pp_utime +pp_values +pp_vec +pp_wait +pp_waitpid +pp_wantarray +pp_warn +pp_xor +prepend_elem +push_return +push_scope +pv_grow +q +ref +refkids +regcomp +regdump +regexec +regfree +regnext +regprop +repeatcpy +rninstr +run +save_I32 +save_aptr +save_ary +save_hash +save_hptr +save_int +save_item +save_list +save_nogv +save_scalar +save_sptr +save_svref +savestack_grow +savestr +sawparens +scalar +scalarkids +scalarseq +scalarvoid +scan_const +scan_formline +scan_heredoc +scan_hex +scan_ident +scan_inputsymbol +scan_num +scan_oct +scan_pat +scan_prefix +scan_str +scan_subst +scan_trans +scan_word +scope +screaminstr +setenv_getix +skipspace +sublex_done +sublex_start +sv_2bool +sv_2cv +sv_2iv +sv_2mortal +sv_2nv +sv_2pv +sv_backoff +sv_catpv +sv_catpvn +sv_catsv +sv_chop +sv_clear +sv_cmp +sv_dec +sv_eq +sv_free +sv_gets +sv_grow +sv_inc +sv_insert +sv_isa +sv_len +sv_magic +sv_mortalcopy +sv_peek +sv_ref +sv_replace +sv_reset +sv_setiv +sv_setnv +sv_setptrobj +sv_setpv +sv_setpvn +sv_setsv +sv_unmagic +sv_upgrade +sv_usepvn +taint_env +taint_not +taint_proper +too_few_arguments +too_many_arguments +wait4pid +warn +watch +whichsig +yyerror +yylex +yyparse @@ -43,7 +43,7 @@ #include "EXTERN.h" #include "perl.h" -extern char* rcsid; +extern char rcsid[]; GV * gv_AVadd(gv) @@ -59,7 +59,7 @@ gv_HVadd(gv) register GV *gv; { if (!GvHV(gv)) - GvHV(gv) = newHV(COEFFSIZE); + GvHV(gv) = newHV(); return gv; } @@ -78,16 +78,55 @@ char *name; return gv; } +void +gv_init(gv, stash, name, len, multi) +GV *gv; +HV *stash; +char *name; +STRLEN len; +int multi; +{ + register GP *gp; + + sv_upgrade(gv, SVt_PVGV); + if (SvLEN(gv)) + Safefree(SvPVX(gv)); + Newz(602,gp, 1, GP); + GvGP(gv) = gp; + GvREFCNT(gv) = 1; + GvSV(gv) = NEWSV(72,0); + GvLINE(gv) = curcop->cop_line; + GvEGV(gv) = gv; + sv_magic((SV*)gv, (SV*)gv, '*', name, len); + GvSTASH(gv) = stash; + GvNAME(gv) = nsavestr(name, len); + GvNAMELEN(gv) = len; + if (multi) + SvMULTI_on(gv); +} + GV * -gv_fetchmethod(stash, name) +gv_fetchmeth(stash, name, len) HV* stash; char* name; +STRLEN len; { AV* av; + GV* topgv; GV* gv; - GV** gvp = (GV**)hv_fetch(stash,name,strlen(name),FALSE); - if (gvp && (gv = *gvp) != (GV*)&sv_undef && GvCV(gv)) - return gv; + GV** gvp; + + gvp = (GV**)hv_fetch(stash, name, len, TRUE); + + DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) ); + topgv = *gvp; + if (SvTYPE(topgv) != SVt_PVGV) + gv_init(topgv, stash, name, len, TRUE); + + if (GvCV(topgv)) { + if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation) + return topgv; + } gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE); if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) { @@ -98,101 +137,136 @@ char* name; SV* sv = *svp++; *tmpbuf = '_'; SvUPGRADE(sv, SVt_PV); - strcpy(tmpbuf+1,SvPVn(sv)); + strcpy(tmpbuf+1, SvPV(sv, na)); gv = gv_fetchpv(tmpbuf,FALSE); if (!gv || !(stash = GvHV(gv))) { if (dowarn) warn("Can't locate package %s for @%s'ISA", - SvPV(sv), HvNAME(stash)); + SvPVX(sv), HvNAME(stash)); continue; } - gv = gv_fetchmethod(stash, name); - if (gv) + gv = gv_fetchmeth(stash, name, len); + if (gv) { + GvCV(topgv) = GvCV(gv); /* cache the CV */ + GvCVGEN(topgv) = sub_generation; /* valid for now */ return gv; + } } } return 0; } GV * -gv_fetchpv(name,add) -register char *name; +gv_fetchmethod(stash, name) +HV* stash; +char* name; +{ + register char *nend; + + for (nend = name; *nend; nend++) { + if (*nend == ':' || *nend == '\'') { + return gv_fetchpv(name, FALSE); + } + } + return gv_fetchmeth(stash, name, nend - name); +} + +GV * +gv_fetchpv(nambeg,add) +char *nambeg; I32 add; { - register GV *gv; + register char *name = nambeg; + register GV *gv = 0; GV**gvp; - register GP *gp; I32 len; register char *namend; - HV *stash; - char *sawquote = Nullch; - char *prevquote = Nullch; + HV *stash = 0; bool global = FALSE; + char tmpbuf[256]; - if (isUPPER(*name)) { - if (*name > 'I') { - if (*name == 'S' && ( - strEQ(name, "SIG") || - strEQ(name, "STDIN") || - strEQ(name, "STDOUT") || - strEQ(name, "STDERR") )) - global = TRUE; - } - else if (*name > 'E') { - if (*name == 'I' && strEQ(name, "INC")) - global = TRUE; - } - else if (*name > 'A') { - if (*name == 'E' && strEQ(name, "ENV")) - global = TRUE; - } - else if (*name == 'A' && ( - strEQ(name, "ARGV") || - strEQ(name, "ARGVOUT") )) - global = TRUE; - } for (namend = name; *namend; namend++) { - if (*namend == '\'' && namend[1]) - prevquote = sawquote, sawquote = namend; - } - if (sawquote == name && name[1]) { - stash = defstash; - sawquote = Nullch; - name++; - } - else if (!isALPHA(*name) || global) - stash = defstash; - else if ((COP*)curcop == &compiling) - stash = curstash; - else - stash = curcop->cop_stash; - if (sawquote) { - char tmpbuf[256]; - char *s, *d; - - *sawquote = '\0'; - /*SUPPRESS 560*/ - if (s = prevquote) { - strncpy(tmpbuf,name,s-name+1); - d = tmpbuf+(s-name+1); - *d++ = '_'; - strcpy(d,s+1); - } - else { + if ((*namend == '\'' && namend[1]) || + (*namend == ':' && namend[1] == ':')) + { + len = namend - name; *tmpbuf = '_'; - strcpy(tmpbuf+1,name); + Copy(name, tmpbuf+1, len, char); + len++; + tmpbuf[len] = '\0'; + if (!stash) + stash = defstash; + + if (len > 1) { + gvp = (GV**)hv_fetch(stash,tmpbuf,len,add); + if (!gvp || *gvp == (GV*)&sv_undef) + return Nullgv; + gv = *gvp; + if (SvTYPE(gv) == SVt_PVGV) + SvMULTI_on(gv); + else + gv_init(gv, stash, nambeg, namend - nambeg, (add & 2)); + if (!(stash = GvHV(gv))) + stash = GvHV(gv) = newHV(); + if (!HvNAME(stash)) + HvNAME(stash) = nsavestr(nambeg, namend - nambeg); + } + + if (*namend == ':') + namend++; + namend++; + name = namend; + if (!*name) + return gv ? gv : defgv; } - gv = gv_fetchpv(tmpbuf,TRUE); - if (!(stash = GvHV(gv))) - stash = GvHV(gv) = newHV(0); - if (!HvNAME(stash)) - HvNAME(stash) = savestr(name); - name = sawquote+1; - *sawquote = '\''; } + + /* No stash in name, so see how we can default */ + + if (!stash) { + if (isIDFIRST(*name)) { + if (isUPPER(*name)) { + if (*name > 'I') { + if (*name == 'S' && ( + strEQ(name, "SIG") || + strEQ(name, "STDIN") || + strEQ(name, "STDOUT") || + strEQ(name, "STDERR") )) + global = TRUE; + } + else if (*name > 'E') { + if (*name == 'I' && strEQ(name, "INC")) + global = TRUE; + } + else if (*name > 'A') { + if (*name == 'E' && strEQ(name, "ENV")) + global = TRUE; + } + else if (*name == 'A' && ( + strEQ(name, "ARGV") || + strEQ(name, "ARGVOUT") )) + global = TRUE; + } + else if (*name == '_' && !name[1]) + global = TRUE; + if (global) + stash = defstash; + else if ((COP*)curcop == &compiling) + stash = curstash; + else + stash = curcop->cop_stash; + } + else + stash = defstash; + } + + /* By this point we should have a stash and a name */ + if (!stash) - fatal("Global symbol \"%s\" requires explicit package name", name); + croak("Global symbol \"%s\" requires explicit package name", name); len = namend - name; + if (!len) + len = 1; gvp = (GV**)hv_fetch(stash,name,len,add); if (!gvp || *gvp == (GV*)&sv_undef) return Nullgv; @@ -204,26 +278,16 @@ I32 add; /* Adding a new symbol */ - sv_upgrade(gv, SVt_PVGV); - if (SvLEN(gv)) - Safefree(SvPV(gv)); - Newz(602,gp, 1, GP); - GvGP(gv) = gp; - GvREFCNT(gv) = 1; - GvSV(gv) = NEWSV(72,0); - GvLINE(gv) = curcop->cop_line; - GvEGV(gv) = gv; - sv_magic((SV*)gv, (SV*)gv, '*', name, len); - GvSTASH(gv) = stash; - GvNAME(gv) = nsavestr(name, len); - GvNAMELEN(gv) = len; - if (isDIGIT(*name) && *name != '0') - sv_magic(GvSV(gv), (SV*)gv, 0, name, len); - if (add & 2) - SvMULTI_on(gv); + gv_init(gv, stash, name, len, add & 2); /* set up magic where warranted */ switch (*name) { + case 'I': + if (strEQ(name, "ISA")) { + AV* av = GvAVn(gv); + sv_magic((SV*)av, (SV*)gv, 'I', 0, 0); + } + break; case 'S': if (strEQ(name, "SIG")) { HV *hv; @@ -241,21 +305,29 @@ I32 add; break; case '&': + if (len > 1) + break; ampergv = gv; sawampersand = TRUE; goto magicalize; case '`': + if (len > 1) + break; leftgv = gv; sawampersand = TRUE; goto magicalize; case '\'': + if (len > 1) + break; rightgv = gv; sawampersand = TRUE; goto magicalize; case ':': + if (len > 1) + break; sv_setpv(GvSV(gv),chopset); goto magicalize; @@ -285,23 +357,41 @@ I32 add; case '\024': case '\027': case '\006': + if (len > 1) + break; + goto magicalize; + + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': magicalize: - sv_magic(GvSV(gv), (SV*)gv, 0, name, 1); + sv_magic(GvSV(gv), (SV*)gv, 0, name, len); break; case '\014': + if (len > 1) + break; sv_setpv(GvSV(gv),"\f"); formfeed = GvSV(gv); break; case ';': + if (len > 1) + break; sv_setpv(GvSV(gv),"\034"); break; - case ']': { + case ']': + if (len == 1) { SV *sv; sv = GvSV(gv); sv_upgrade(sv, SVt_PVNV); sv_setpv(sv,rcsid); - SvNV(sv) = atof(patchlevel); + SvNVX(sv) = atof(patchlevel); SvNOK_on(sv); } break; @@ -320,7 +410,7 @@ GV *gv; return; sv_setpv(sv, sv == (SV*)gv ? "*" : ""); sv_catpv(sv,HvNAME(hv)); - sv_catpvn(sv,"'", 1); + sv_catpvn(sv,"::", 2); sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv)); } @@ -336,7 +426,7 @@ GV *gv; return; sv_setpv(sv, sv == (SV*)gv ? "*" : ""); sv_catpv(sv,HvNAME(hv)); - sv_catpvn(sv,"'", 1); + sv_catpvn(sv,"::", 2); sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv)); } @@ -351,21 +441,28 @@ newIO() } void -gv_check(min,max) -I32 min; -register I32 max; +gv_check(stash) +HV* stash; { register HE *entry; register I32 i; register GV *gv; - - for (i = min; i <= max; i++) { - for (entry = HvARRAY(defstash)[i]; entry; entry = entry->hent_next) { - gv = (GV*)entry->hent_val; - if (SvMULTI(gv)) - continue; - curcop->cop_line = GvLINE(gv); - warn("Possible typo: \"%s\"", GvNAME(gv)); + HV *hv; + + for (i = 0; i <= HvMAX(stash); i++) { + for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) { + if (isALPHA(*entry->hent_key)) { + gv = (GV*)entry->hent_val; + if (SvMULTI(gv)) + continue; + curcop->cop_line = GvLINE(gv); + warn("Possible typo: \"%s::%s\"", HvNAME(stash), GvNAME(gv)); + } + else if (*entry->hent_key == '_' && + (gv = (GV*)entry->hent_val) && + (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash) + gv_check(hv); /* nested package */ + } } } @@ -405,9 +502,9 @@ GV* gv; if (--gp->gp_refcnt > 0) return; - sv_free(gp->gp_sv); - sv_free(gp->gp_av); - sv_free(gp->gp_hv); + sv_free((SV*)gp->gp_sv); + sv_free((SV*)gp->gp_av); + sv_free((SV*)gp->gp_hv); if (io = gp->gp_io) { do_close(gv,FALSE); Safefree(io->top_name); @@ -415,7 +512,7 @@ GV* gv; Safefree(io); } if (cv = gp->gp_cv) - sv_free(cv); + sv_free((SV*)cv); Safefree(gp); GvGP(gv) = 0; } @@ -452,7 +549,7 @@ I32 num; if (op->op_private < num) return 0; if (op->op_flags & OPf_STACKED) - return gv_fetchpv(SvPVnx(*(stack_sp--)),TRUE); + return gv_fetchpv(SvPVx(*(stack_sp--), na),TRUE); else return cGVOP->op_gv; } @@ -467,7 +564,7 @@ I32 num; if (op->op_private < num) return 0; if (op->op_flags & OPf_STACKED) - gv = gv_fetchpv(SvPVnx(*(stack_sp--)),TRUE); + gv = gv_fetchpv(SvPVx(*(stack_sp--), na),TRUE); else gv = cGVOP->op_gv; @@ -33,6 +33,7 @@ struct gp { HV * gp_hv; /* associative array value */ GV * gp_egv; /* effective gv, if *glob */ CV * gp_cv; /* subroutine value */ + 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) */ char gp_flags; @@ -73,6 +74,7 @@ HV *GvHVn(); #endif /* Microport 2.4 hack */ #define GvCV(gv) (GvGP(gv)->gp_cv) +#define GvCVGEN(gv) (GvGP(gv)->gp_cvgen) #define GvLASTEXPR(gv) (GvGP(gv)->gp_lastexpr) @@ -104,6 +106,7 @@ struct io { GV * top_gv; /* $^ */ char * fmt_name; /* $~ */ GV * fmt_gv; /* $~ */ + SV * object; short subprocess; /* -| or |- */ char type; char flags; @@ -67,7 +67,7 @@ foreach $file (@ARGV) { $args = "local($args) = \@_;\n$t "; } s/^\s+//; - do expr(); + &expr(); $new =~ s/(["\\])/\\$1/g; if ($t ne '') { $new =~ s/(['\\])/\\$1/g; @@ -81,7 +81,7 @@ foreach $file (@ARGV) { } else { s/^\s+//; - do expr(); + &expr(); $new = 1 if $new eq ''; if ($t ne '') { $new =~ s/(['\\])/\\$1/g; @@ -108,14 +108,14 @@ foreach $file (@ARGV) { } elsif (s/^if\s+//) { $new = ''; - do expr(); + &expr(); print OUT $t,"if ($new) {\n"; $tab += 4; $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); } elsif (s/^elif\s+//) { $new = ''; - do expr(); + &expr(); $tab -= 4; $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); print OUT $t,"}\n${t}elsif ($new) {\n"; @@ -193,7 +193,7 @@ sub expr { } } else { - $new .= ' &' . $id; + $new .= ' eval{&' . $id . '}'; } next; }; diff --git a/hints/aix_rs.sh b/hints/aix_rs.sh index 76e55ca4b4..5bf193b380 100644 --- a/hints/aix_rs.sh +++ b/hints/aix_rs.sh @@ -5,14 +5,6 @@ d_setruid='undef' d_setegid='undef' d_seteuid='undef' alignbytes=8 -dolist_cflags='optimize=""' -tdolist_cflags='optimize=""' -regexec_cflags='optimize=""' -tregexec_cflags='optimize=""' -eval_cflags='optimize=""' -teval_cflags='optimize=""' -toke_cflags='optimize=""' -ttoke_cflags='optimize=""' ccflags="$ccflags -D_NO_PROTO" cppstdin='/lib/cpp -D_AIX -D_IBMR2 -U__STR__' cppminus='' @@ -43,44 +43,39 @@ I32 lval; register I32 i; register I32 hash; register HE *entry; - register I32 maxi; SV *sv; -#ifdef SOME_DBM - datum dkey,dcontent; -#endif if (!hv) return 0; + + if (SvMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + sv = sv_2mortal(NEWSV(61,0)); + mg_copy((SV*)hv, sv, key, klen); + if (!lval) { + mg_get(sv); + sv_unmagic(sv,'p'); + } + Sv = sv; + return &Sv; + } + } + xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array) { if (lval) - Newz(503,xhv->xhv_array, xhv->xhv_max + 1, HE*); + Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); else return 0; } - /* The hash function we use on symbols has to be equal to the first - * character when taken modulo 128, so that sv_reset() can be implemented - * efficiently. We throw in the second character and the last character - * (times 128) so that long chains of identifiers starting with the - * same letter don't have to be strEQ'ed within hv_fetch(), since it - * compares hash values before trying strEQ(). - */ - if (!xhv->xhv_coeffsize && klen) - hash = klen ? *key + 128 * key[1] + 128 * key[klen-1] : 0; - else { /* use normal coefficients */ - if (klen < xhv->xhv_coeffsize) - maxi = klen; - else - maxi = xhv->xhv_coeffsize; - for (s=key, i=0, hash = 0; - i < maxi; /*SUPPRESS 8*/ - s++, i++, hash *= 5) { - hash += *s * coeff[i]; - } - } + i = klen; + hash = 0; + s = key; + while (i--) + hash = hash * 33 + *s++; - entry = xhv->xhv_array[hash & xhv->xhv_max]; + entry = ((HE**)xhv->xhv_array)[hash & xhv->xhv_max]; for (; entry; entry = entry->hent_next) { if (entry->hent_hash != hash) /* strings can't be equal */ continue; @@ -90,22 +85,6 @@ I32 lval; continue; return &entry->hent_val; } -#ifdef SOME_DBM - if (xhv->xhv_dbm) { - dkey.dptr = key; - dkey.dsize = klen; -#ifdef HAS_GDBM - dcontent = gdbm_fetch(xhv->xhv_dbm,dkey); -#else - dcontent = dbm_fetch(xhv->xhv_dbm,dkey); -#endif - if (dcontent.dptr) { /* found one */ - sv = NEWSV(60,dcontent.dsize); - sv_setpvn(sv,dcontent.dptr,dcontent.dsize); - return hv_store(hv,key,klen,sv,hash); /* cache it */ - } - } -#endif if (lval) { /* gonna assign to this, so it better be there */ sv = NEWSV(61,0); return hv_store(hv,key,klen,sv,hash); @@ -126,39 +105,30 @@ register U32 hash; register I32 i; register HE *entry; register HE **oentry; - register I32 maxi; if (!hv) return 0; xhv = (XPVHV*)SvANY(hv); - if (hash) - /*SUPPRESS 530*/ - ; - else if (!xhv->xhv_coeffsize && klen) - hash = klen ? *key + 128 * key[1] + 128 * key[klen-1] : 0; - else { /* use normal coefficients */ - if (klen < xhv->xhv_coeffsize) - maxi = klen; - else - maxi = xhv->xhv_coeffsize; - for (s=key, i=0, hash = 0; - i < maxi; /*SUPPRESS 8*/ - s++, i++, hash *= 5) { - hash += *s * coeff[i]; - } + if (SvMAGICAL(hv)) { + MAGIC* mg = SvMAGIC(hv); + mg_copy((SV*)hv, val, key, klen); + if (!xhv->xhv_array) + return 0; + } + if (!hash) { + i = klen; + s = key; + while (i--) + hash = hash * 33 + *s++; } if (!xhv->xhv_array) - Newz(505,xhv->xhv_array, xhv->xhv_max + 1, HE*); + Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); - oentry = &(xhv->xhv_array[hash & xhv->xhv_max]); + oentry = &((HE**)xhv->xhv_array)[hash & xhv->xhv_max]; i = 1; - if (SvMAGICAL(hv)) { - MAGIC* mg = SvMAGIC(hv); - sv_magic(val, (SV*)hv, tolower(mg->mg_type), key, klen); - } for (entry = *oentry; entry; i=0, entry = entry->hent_next) { if (entry->hent_hash != hash) /* strings can't be equal */ continue; @@ -179,32 +149,12 @@ register U32 hash; entry->hent_next = *oentry; *oentry = entry; - /* hv_dbmstore not necessary here because it's called from sv_setmagic() */ - + xhv->xhv_keys++; if (i) { /* initial entry? */ - xhv->xhv_fill++; -#ifdef SOME_DBM - if (xhv->xhv_dbm && xhv->xhv_max >= DBM_CACHE_MAX) - return &entry->hent_val; -#endif - if (xhv->xhv_fill > xhv->xhv_dosplit) + ++xhv->xhv_fill; + if (xhv->xhv_keys > xhv->xhv_max) hsplit(hv); } -#ifdef SOME_DBM - else if (xhv->xhv_dbm) { /* is this just a cache for dbm file? */ - void he_delayfree(); - HE* ent; - - ent = xhv->xhv_array[hash & xhv->xhv_max]; - oentry = &ent->hent_next; - ent = *oentry; - while (ent) { /* trim chain down to 1 entry */ - *oentry = ent->hent_next; - he_delayfree(ent); /* no doubt they'll want this next, sigh... */ - ent = *oentry; - } - } -#endif return &entry->hent_val; } @@ -222,31 +172,23 @@ U32 klen; register HE *entry; register HE **oentry; SV *sv; - I32 maxi; -#ifdef SOME_DBM - datum dkey; -#endif if (!hv) return Nullsv; + if (SvMAGICAL(hv)) { + sv = *hv_fetch(hv, key, klen, TRUE); + mg_clear(sv); + } xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array) return Nullsv; - if (!xhv->xhv_coeffsize && klen) - hash = klen ? *key + 128 * key[1] + 128 * key[klen-1] : 0; - else { /* use normal coefficients */ - if (klen < xhv->xhv_coeffsize) - maxi = klen; - else - maxi = xhv->xhv_coeffsize; - for (s=key, i=0, hash = 0; - i < maxi; /*SUPPRESS 8*/ - s++, i++, hash *= 5) { - hash += *s * coeff[i]; - } - } + i = klen; + hash = 0; + s = key; + while (i--) + hash = hash * 33 + *s++; - oentry = &(xhv->xhv_array[hash & xhv->xhv_max]); + oentry = &((HE**)xhv->xhv_array)[hash & xhv->xhv_max]; entry = *oentry; i = 1; for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) { @@ -261,26 +203,10 @@ U32 klen; xhv->xhv_fill--; sv = sv_mortalcopy(entry->hent_val); he_free(entry); -#ifdef SOME_DBM - do_dbm_delete: - if (xhv->xhv_dbm) { - dkey.dptr = key; - dkey.dsize = klen; -#ifdef HAS_GDBM - gdbm_delete(xhv->xhv_dbm,dkey); -#else - dbm_delete(xhv->xhv_dbm,dkey); -#endif - } -#endif + --xhv->xhv_keys; return sv; } -#ifdef SOME_DBM - sv = Nullsv; - goto do_dbm_delete; -#else return Nullsv; -#endif } static void @@ -296,18 +222,13 @@ HV *hv; register HE *entry; register HE **oentry; - a = xhv->xhv_array; + a = (HE**)xhv->xhv_array; nomemok = TRUE; Renew(a, newsize, HE*); nomemok = FALSE; - if (!a) { - xhv->xhv_dosplit = xhv->xhv_max + 1; /* never split again */ - return; - } Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/ xhv->xhv_max = --newsize; - xhv->xhv_dosplit = xhv->xhv_max * FILLPCT / 100; - xhv->xhv_array = a; + xhv->xhv_array = (char*)a; for (i=0; i<oldsize; i++,a++) { if (!*a) /* non-existent */ @@ -331,8 +252,7 @@ HV *hv; } HV * -newHV(lookat) -U32 lookat; +newHV() { register HV *hv; register XPVHV* xhv; @@ -343,20 +263,9 @@ U32 lookat; xhv = (XPVHV*)SvANY(hv); SvPOK_off(hv); SvNOK_off(hv); - if (lookat) { - xhv->xhv_coeffsize = lookat; - xhv->xhv_max = 7; /* it's a normal associative array */ - xhv->xhv_dosplit = xhv->xhv_max * FILLPCT / 100; - } - else { - xhv->xhv_max = 127; /* it's a symbol table */ - xhv->xhv_dosplit = 128; /* so never split */ - } + xhv->xhv_max = 7; /* start with 8 buckets */ xhv->xhv_fill = 0; xhv->xhv_pmroot = 0; -#ifdef SOME_DBM - xhv->xhv_dbm = 0; -#endif (void)hv_iterinit(hv); /* so each() will start off right */ return hv; } @@ -384,81 +293,32 @@ register HE *hent; } void -hv_clear(hv,dodbm) +hv_clear(hv) HV *hv; -I32 dodbm; { register XPVHV* xhv; if (!hv) return; xhv = (XPVHV*)SvANY(hv); - hfreeentries(hv,dodbm); + hfreeentries(hv); xhv->xhv_fill = 0; -#ifndef lint if (xhv->xhv_array) - (void)memzero((char*)xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*)); -#endif + (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*)); } static void -hfreeentries(hv,dodbm) +hfreeentries(hv) HV *hv; -I32 dodbm; { register XPVHV* xhv; register HE *hent; register HE *ohent = Null(HE*); -#ifdef SOME_DBM - datum dkey; - datum nextdkey; -#ifdef HAS_GDBM - GDBM_FILE old_dbm; -#else -#ifdef HAS_NDBM - DBM *old_dbm; -#else - I32 old_dbm; -#endif -#endif -#endif if (!hv) return; xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array) return; -#ifdef SOME_DBM - if ((old_dbm = xhv->xhv_dbm) && dodbm) { -#ifdef HAS_GDBM - while (dkey = gdbm_firstkey(xhv->xhv_dbm), dkey.dptr) { -#else - while (dkey = dbm_firstkey(xhv->xhv_dbm), dkey.dptr) { -#endif - do { -#ifdef HAS_GDBM - nextdkey = gdbm_nextkey(xhv->xhv_dbm, dkey); -#else -#ifdef HAS_NDBM -#ifdef _CX_UX - nextdkey = dbm_nextkey(xhv->xhv_dbm, dkey); -#else - nextdkey = dbm_nextkey(xhv->xhv_dbm); -#endif -#else - nextdkey = nextkey(dkey); -#endif -#endif -#ifdef HAS_GDBM - gdbm_delete(xhv->xhv_dbm,dkey); -#else - dbm_delete(xhv->xhv_dbm,dkey); -#endif - dkey = nextdkey; - } while (dkey.dptr); /* one way or another, this works */ - } - } - xhv->xhv_dbm = 0; /* now clear just cache */ -#endif (void)hv_iterinit(hv); /*SUPPRESS 560*/ while (hent = hv_iternext(hv)) { /* concise but not very efficient */ @@ -466,48 +326,33 @@ I32 dodbm; ohent = hent; } he_free(ohent); -#ifdef SOME_DBM - xhv->xhv_dbm = old_dbm; -#endif if (SvMAGIC(hv)) - mg_clear(hv); + mg_clear((SV*)hv); } void -hv_undef(hv,dodbm) +hv_undef(hv) HV *hv; -I32 dodbm; { register XPVHV* xhv; if (!hv) return; xhv = (XPVHV*)SvANY(hv); - hfreeentries(hv,dodbm); + hfreeentries(hv); Safefree(xhv->xhv_array); xhv->xhv_array = 0; - if (xhv->xhv_coeffsize) { - xhv->xhv_max = 7; /* it's a normal associative array */ - xhv->xhv_dosplit = xhv->xhv_max * FILLPCT / 100; - } - else { - xhv->xhv_max = 127; /* it's a symbol table */ - xhv->xhv_dosplit = 128; /* so never split */ - } + xhv->xhv_max = 7; /* it's a normal associative array */ xhv->xhv_fill = 0; -#ifdef SOME_DBM - xhv->xhv_dbm = 0; -#endif (void)hv_iterinit(hv); /* so each() will start off right */ } void -hv_free(hv,dodbm) +hv_free(hv) register HV *hv; -I32 dodbm; { if (!hv) return; - hfreeentries(hv,dodbm); + hfreeentries(hv); Safefree(HvARRAY(hv)); Safefree(hv); } @@ -528,60 +373,39 @@ HV *hv; { register XPVHV* xhv; register HE *entry; -#ifdef SOME_DBM - datum key; -#endif + MAGIC* mg; if (!hv) - fatal("Bad associative array"); + croak("Bad associative array"); xhv = (XPVHV*)SvANY(hv); entry = xhv->xhv_eiter; -#ifdef SOME_DBM - if (xhv->xhv_dbm) { - if (entry) { -#ifdef HAS_GDBM - key.dptr = entry->hent_key; - key.dsize = entry->hent_klen; - key = gdbm_nextkey(xhv->xhv_dbm, key); -#else -#ifdef HAS_NDBM -#ifdef _CX_UX - key.dptr = entry->hent_key; - key.dsize = entry->hent_klen; - key = dbm_nextkey(xhv->xhv_dbm, key); -#else - key = dbm_nextkey(xhv->xhv_dbm); -#endif /* _CX_UX */ -#else - key.dptr = entry->hent_key; - key.dsize = entry->hent_klen; - key = nextkey(key); -#endif -#endif - } - else { - Newz(504,entry, 1, HE); - xhv->xhv_eiter = entry; -#ifdef HAS_GDBM - key = gdbm_firstkey(xhv->xhv_dbm); -#else - key = dbm_firstkey(xhv->xhv_dbm); -#endif - } - entry->hent_key = key.dptr; - entry->hent_klen = key.dsize; - if (!key.dptr) { - if (entry->hent_val) - sv_free(entry->hent_val); - Safefree(entry); - xhv->xhv_eiter = Null(HE*); - return Null(HE*); - } - return entry; + + if (SvMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { + SV *key = sv_2mortal(NEWSV(0,0)); + if (entry) + sv_setpvn(key, entry->hent_key, entry->hent_klen); + else { + Newz(504,entry, 1, HE); + xhv->xhv_eiter = entry; + } + magic_nextpack(hv,mg,key); + if (SvOK(key)) { + STRLEN len; + entry->hent_key = SvPV(key, len); + entry->hent_klen = len; + SvPOK_off(key); + SvPVX(key) = 0; + return entry; + } + if (entry->hent_val) + sv_free(entry->hent_val); + Safefree(entry); + xhv->xhv_eiter = Null(HE*); + return Null(HE*); } -#endif + if (!xhv->xhv_array) - Newz(506,xhv->xhv_array, xhv->xhv_max + 1, HE*); + Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); do { if (entry) entry = entry->hent_next; @@ -591,7 +415,7 @@ HV *hv; xhv->xhv_riter = -1; break; } - entry = xhv->xhv_array[xhv->xhv_riter]; + entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter]; } } while (!entry); @@ -613,195 +437,23 @@ hv_iterval(hv,entry) HV *hv; register HE *entry; { -#ifdef SOME_DBM - register XPVHV* xhv; - datum key, content; - - if (!hv) - fatal("Bad associative array"); - xhv = (XPVHV*)SvANY(hv); - if (xhv->xhv_dbm) { - key.dptr = entry->hent_key; - key.dsize = entry->hent_klen; -#ifdef HAS_GDBM - content = gdbm_fetch(xhv->xhv_dbm,key); -#else - content = dbm_fetch(xhv->xhv_dbm,key); -#endif - if (!entry->hent_val) - entry->hent_val = NEWSV(62,0); - sv_setpvn(entry->hent_val,content.dptr,content.dsize); + if (SvMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + SV* sv = sv_2mortal(NEWSV(61,0)); + mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen); + mg_get(sv); + sv_unmagic(sv,'p'); + return sv; + } } -#endif return entry->hent_val; } -#ifdef SOME_DBM - -#ifndef OP_CREAT -# ifdef I_FCNTL -# include <fcntl.h> -# endif -# ifdef I_SYS_FILE -# include <sys/file.h> -# endif -#endif - -#ifndef OP_RDONLY -#define OP_RDONLY 0 -#endif -#ifndef OP_RDWR -#define OP_RDWR 2 -#endif -#ifndef OP_CREAT -#define OP_CREAT 01000 -#endif - -bool -hv_dbmopen(hv,fname,mode) -HV *hv; -char *fname; -I32 mode; -{ - register XPVHV* xhv; - if (!hv) - return FALSE; - xhv = (XPVHV*)SvANY(hv); -#ifdef HAS_ODBM - if (xhv->xhv_dbm) /* never really closed it */ - return TRUE; -#endif - if (xhv->xhv_dbm) { - hv_dbmclose(hv); - xhv->xhv_dbm = 0; - } - hv_clear(hv, FALSE); /* clear cache */ -#ifdef HAS_GDBM - if (mode >= 0) - xhv->xhv_dbm = gdbm_open(fname, 0, GDBM_WRCREAT,mode, (void *) NULL); - if (!xhv->xhv_dbm) - xhv->xhv_dbm = gdbm_open(fname, 0, GDBM_WRITER, mode, (void *) NULL); - if (!xhv->xhv_dbm) - xhv->xhv_dbm = gdbm_open(fname, 0, GDBM_READER, mode, (void *) NULL); -#else -#ifdef HAS_NDBM - if (mode >= 0) - xhv->xhv_dbm = dbm_open(fname, OP_RDWR|OP_CREAT, mode); - if (!xhv->xhv_dbm) - xhv->xhv_dbm = dbm_open(fname, OP_RDWR, mode); - if (!xhv->xhv_dbm) - xhv->xhv_dbm = dbm_open(fname, OP_RDONLY, mode); -#else - if (dbmrefcnt++) - fatal("Old dbm can only open one database"); - sprintf(buf,"%s.dir",fname); - if (stat(buf, &statbuf) < 0) { - if (mode < 0 || close(creat(buf,mode)) < 0) - return FALSE; - sprintf(buf,"%s.pag",fname); - if (close(creat(buf,mode)) < 0) - return FALSE; - } - xhv->xhv_dbm = dbminit(fname) >= 0; -#endif -#endif - if (!xhv->xhv_array && xhv->xhv_dbm != 0) - Newz(507,xhv->xhv_array, xhv->xhv_max + 1, HE*); - hv_magic(hv, 0, 'D'); - return xhv->xhv_dbm != 0; -} - -void -hv_dbmclose(hv) -HV *hv; -{ - register XPVHV* xhv; - if (!hv) - fatal("Bad associative array"); - xhv = (XPVHV*)SvANY(hv); - if (xhv->xhv_dbm) { -#ifdef HAS_GDBM - gdbm_close(xhv->xhv_dbm); - xhv->xhv_dbm = 0; -#else -#ifdef HAS_NDBM - dbm_close(xhv->xhv_dbm); - xhv->xhv_dbm = 0; -#else - /* dbmrefcnt--; */ /* doesn't work, rats */ -#endif -#endif - } - else if (dowarn) - warn("Close on unopened dbm file"); -} - -bool -hv_dbmstore(hv,key,klen,sv) -HV *hv; -char *key; -U32 klen; -register SV *sv; -{ - register XPVHV* xhv; - datum dkey, dcontent; - I32 error; - - if (!hv) - return FALSE; - xhv = (XPVHV*)SvANY(hv); - if (!xhv->xhv_dbm) - return FALSE; - dkey.dptr = key; - dkey.dsize = klen; - dcontent.dptr = SvPVn(sv); - dcontent.dsize = SvCUR(sv); -#ifdef HAS_GDBM - error = gdbm_store(xhv->xhv_dbm, dkey, dcontent, GDBM_REPLACE); -#else - error = dbm_store(xhv->xhv_dbm, dkey, dcontent, DBM_REPLACE); -#endif - if (error) { - if (errno == EPERM) - fatal("No write permission to dbm file"); - fatal("dbm store returned %d, errno %d, key \"%s\"",error,errno,key); -#ifdef HAS_NDBM - dbm_clearerr(xhv->xhv_dbm); -#endif - } - return !error; -} -#endif /* SOME_DBM */ - -#ifdef XXX - magictype = MgTYPE(magic); - switch (magictype) { - case 'E': - environ[0] = Nullch; - break; - case 'S': -#ifndef NSIG -#define NSIG 32 -#endif - for (i = 1; i < NSIG; i++) - signal(i, SIG_DFL); /* crunch, crunch, crunch */ - break; - } - - if (magic) { - sv_magic(tmpstr, (SV*)tmpgv, magic, tmps, SvCUR(sv)); - sv_magicset(tmpstr, magic); - } - - if (hv->hv_sv.sv_rare && !sv->sv_magic) - sv_magic(sv, (GV*)hv, hv->hv_sv.sv_rare, key, keylen); -#endif - void hv_magic(hv, gv, how) HV* hv; GV* gv; I32 how; { - sv_magic(hv, gv, how, 0, 0); + sv_magic((SV*)hv, (SV*)gv, how, 0, 0); } @@ -19,12 +19,6 @@ * */ -#define FILLPCT 80 /* don't make greater than 99 */ -#define DBM_CACHE_MAX 63 /* cache 64 entries for dbm file */ - /* (resident array acts as a write-thru cache)*/ - -#define COEFFSIZE (16 * 8) /* size of coeff array */ - typedef struct he HE; struct he { @@ -36,47 +30,26 @@ struct he { }; struct xpvhv { - char * xpv_pv; /* pointer to malloced string */ - STRLEN xpv_cur; /* length of xp_pv as a C string */ - STRLEN xpv_len; /* allocated size */ - STRLEN xof_off; /* ptr is incremented by offset */ + char * xhv_array; /* pointer to malloced string */ + STRLEN xhv_fill; /* how full xhv_array currently is */ + STRLEN xhv_max; /* subscript of last element of xhv_array */ + STRLEN xhv_keys; /* how many elements in the array */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ - MAGIC* xhv_magic; /* magic for elements */ - - HE **xhv_array; - I32 xhv_max; /* subscript of last element of xhv_array */ - I32 xhv_dosplit; /* how full to get before splitting */ - I32 xhv_fill; /* how full xhv_array currently is */ I32 xhv_riter; /* current root of iterator */ HE *xhv_eiter; /* current entry of iterator */ PMOP *xhv_pmroot; /* list of pm's for this package */ char *xhv_name; /* name, if a symbol table */ -#ifdef SOME_DBM -#ifdef HAS_GDBM - GDBM_FILE xhv_dbm; -#else -#ifdef HAS_NDBM - DBM *xhv_dbm; -#else - I32 xhv_dbm; -#endif -#endif -#endif - unsigned char xhv_coeffsize; /* is 0 for symbol tables */ }; #define Nullhv Null(HV*) -#define HvMAGIC(hv) ((XPVHV*) SvANY(hv))->xhv_magic -#define HvARRAY(hv) ((XPVHV*) SvANY(hv))->xhv_array -#define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max -#define HvDOSPLIT(hv) ((XPVHV*) SvANY(hv))->xhv_dosplit +#define HvARRAY(hv) ((HE**)((XPVHV*) SvANY(hv))->xhv_array) #define HvFILL(hv) ((XPVHV*) SvANY(hv))->xhv_fill +#define HvMAX(hv) ((XPVHV*) SvANY(hv))->xhv_max +#define HvKEYS(hv) ((XPVHV*) SvANY(hv))->xhv_keys #define HvRITER(hv) ((XPVHV*) SvANY(hv))->xhv_riter #define HvEITER(hv) ((XPVHV*) SvANY(hv))->xhv_eiter #define HvPMROOT(hv) ((XPVHV*) SvANY(hv))->xhv_pmroot #define HvNAME(hv) ((XPVHV*) SvANY(hv))->xhv_name -#define HvDBM(hv) ((XPVHV*) SvANY(hv))->xhv_dbm -#define HvCOEFFSIZE(hv) ((XPVHV*) SvANY(hv))->xhv_coeffsize diff --git a/hvdbm.h b/hvdbm.h new file mode 100644 index 0000000000..b45db4c5d4 --- /dev/null +++ b/hvdbm.h @@ -0,0 +1,58 @@ +#define DBM_CACHE_MAX 63 /* cache 64 entries for dbm file */ + /* (resident array acts as a write-thru cache)*/ +#ifdef WANT_DBZ +# include <dbz.h> +# define SOME_DBM +# define dbm_fetch(db,dkey) fetch(dkey) +# define dbm_delete(db,dkey) croak("dbz doesn't implement delete") +# define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent) +# define dbm_close(db) dbmclose() +# define dbm_firstkey(db) (croak("dbz doesn't implement traversal"),fetch()) +# define nextkey() (croak("dbz doesn't implement traversal"),fetch()) +# define dbm_nextkey(db) (croak("dbz doesn't implement traversal"),fetch()) +# ifdef HAS_NDBM +# undef HAS_NDBM +# endif +# ifndef HAS_ODBM +# define HAS_ODBM +# endif +#else +# ifdef HAS_GDBM +# ifdef I_GDBM +# include <gdbm.h> +# endif +# define SOME_DBM +# ifdef HAS_NDBM +# undef HAS_NDBM +# endif +# ifdef HAS_ODBM +# undef HAS_ODBM +# endif +# else +# ifdef HAS_NDBM +# include <ndbm.h> +# define SOME_DBM +# ifdef HAS_ODBM +# undef HAS_ODBM +# endif +# else +# ifdef HAS_ODBM +# ifdef NULL +# undef NULL /* suppress redefinition message */ +# endif +# include <dbm.h> +# ifdef NULL +# undef NULL +# endif +# define NULL 0 /* silly thing is, we don't even use this... */ +# define SOME_DBM +# define dbm_fetch(db,dkey) fetch(dkey) +# define dbm_delete(db,dkey) delete(dkey) +# define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent) +# define dbm_close(db) dbmclose() +# define dbm_firstkey(db) firstkey() +# endif /* HAS_ODBM */ +# endif /* HAS_NDBM */ +# endif /* HAS_GDBM */ +#endif /* WANT_DBZ */ + diff --git a/interp.var b/interp.var index 299e6469f2..3429de6a14 100644 --- a/interp.var +++ b/interp.var @@ -28,7 +28,6 @@ cxstack cxstack_ix cxstack_max dbargs -dbmrefcnt debdelim debname debstash @@ -134,8 +133,8 @@ statname statusvalue stdingv strchop -taintanyway tainted +tainting tmps_floor tmps_ix tmps_max diff --git a/keywords.h b/keywords.h index c659dc6904..09af7861fe 100644 --- a/keywords.h +++ b/keywords.h @@ -2,221 +2,227 @@ #define KEY___LINE__ 1 #define KEY___FILE__ 2 #define KEY___END__ 3 -#define KEY_alarm 4 -#define KEY_accept 5 -#define KEY_atan2 6 -#define KEY_bind 7 -#define KEY_binmode 8 -#define KEY_bless 9 -#define KEY_chop 10 -#define KEY_continue 11 -#define KEY_chdir 12 -#define KEY_close 13 -#define KEY_closedir 14 -#define KEY_cmp 15 -#define KEY_caller 16 -#define KEY_crypt 17 -#define KEY_chmod 18 -#define KEY_chown 19 -#define KEY_connect 20 -#define KEY_cos 21 -#define KEY_chroot 22 -#define KEY_do 23 -#define KEY_die 24 -#define KEY_defined 25 -#define KEY_delete 26 -#define KEY_dbmopen 27 -#define KEY_dbmclose 28 -#define KEY_dump 29 -#define KEY_else 30 -#define KEY_elsif 31 -#define KEY_eq 32 -#define KEY_EQ 33 -#define KEY_exit 34 -#define KEY_eval 35 -#define KEY_eof 36 -#define KEY_exp 37 -#define KEY_each 38 -#define KEY_exec 39 -#define KEY_endhostent 40 -#define KEY_endnetent 41 -#define KEY_endservent 42 -#define KEY_endprotoent 43 -#define KEY_endpwent 44 -#define KEY_endgrent 45 -#define KEY_for 46 -#define KEY_foreach 47 -#define KEY_format 48 -#define KEY_formline 49 -#define KEY_fork 50 -#define KEY_fcntl 51 -#define KEY_fileno 52 -#define KEY_flock 53 -#define KEY_gt 54 -#define KEY_GT 55 -#define KEY_ge 56 -#define KEY_GE 57 -#define KEY_glob 58 -#define KEY_grep 59 -#define KEY_goto 60 -#define KEY_gmtime 61 -#define KEY_getc 62 -#define KEY_getppid 63 -#define KEY_getpgrp 64 -#define KEY_getpriority 65 -#define KEY_getprotobyname 66 -#define KEY_getprotobynumber 67 -#define KEY_getprotoent 68 -#define KEY_getpwent 69 -#define KEY_getpwnam 70 -#define KEY_getpwuid 71 -#define KEY_getpeername 72 -#define KEY_gethostbyname 73 -#define KEY_gethostbyaddr 74 -#define KEY_gethostent 75 -#define KEY_getnetbyname 76 -#define KEY_getnetbyaddr 77 -#define KEY_getnetent 78 -#define KEY_getservbyname 79 -#define KEY_getservbyport 80 -#define KEY_getservent 81 -#define KEY_getsockname 82 -#define KEY_getsockopt 83 -#define KEY_getgrent 84 -#define KEY_getgrnam 85 -#define KEY_getgrgid 86 -#define KEY_getlogin 87 -#define KEY_hex 88 -#define KEY_if 89 -#define KEY_index 90 -#define KEY_int 91 -#define KEY_ioctl 92 -#define KEY_join 93 -#define KEY_keys 94 -#define KEY_kill 95 -#define KEY_last 96 -#define KEY_lc 97 -#define KEY_lcfirst 98 -#define KEY_local 99 -#define KEY_length 100 -#define KEY_lt 101 -#define KEY_LT 102 -#define KEY_le 103 -#define KEY_LE 104 -#define KEY_localtime 105 -#define KEY_log 106 -#define KEY_link 107 -#define KEY_listen 108 -#define KEY_lstat 109 -#define KEY_m 110 -#define KEY_mkdir 111 -#define KEY_msgctl 112 -#define KEY_msgget 113 -#define KEY_msgrcv 114 -#define KEY_msgsnd 115 -#define KEY_my 116 -#define KEY_next 117 -#define KEY_ne 118 -#define KEY_NE 119 -#define KEY_open 120 -#define KEY_ord 121 -#define KEY_oct 122 -#define KEY_opendir 123 -#define KEY_print 124 -#define KEY_printf 125 -#define KEY_push 126 -#define KEY_pop 127 -#define KEY_pack 128 -#define KEY_package 129 -#define KEY_pipe 130 -#define KEY_q 131 -#define KEY_qq 132 -#define KEY_qx 133 -#define KEY_return 134 -#define KEY_require 135 -#define KEY_reset 136 -#define KEY_redo 137 -#define KEY_rename 138 -#define KEY_rand 139 -#define KEY_rmdir 140 -#define KEY_rindex 141 -#define KEY_ref 142 -#define KEY_read 143 -#define KEY_readdir 144 -#define KEY_rewinddir 145 +#define KEY_BEGIN 4 +#define KEY_END 5 +#define KEY_EQ 6 +#define KEY_GE 7 +#define KEY_GT 8 +#define KEY_LE 9 +#define KEY_LT 10 +#define KEY_NE 11 +#define KEY_abs 12 +#define KEY_accept 13 +#define KEY_alarm 14 +#define KEY_and 15 +#define KEY_atan2 16 +#define KEY_bind 17 +#define KEY_binmode 18 +#define KEY_bless 19 +#define KEY_caller 20 +#define KEY_chdir 21 +#define KEY_chmod 22 +#define KEY_chop 23 +#define KEY_chown 24 +#define KEY_chr 25 +#define KEY_chroot 26 +#define KEY_close 27 +#define KEY_closedir 28 +#define KEY_cmp 29 +#define KEY_connect 30 +#define KEY_continue 31 +#define KEY_cos 32 +#define KEY_crypt 33 +#define KEY_dbmclose 34 +#define KEY_dbmopen 35 +#define KEY_defined 36 +#define KEY_delete 37 +#define KEY_die 38 +#define KEY_do 39 +#define KEY_dump 40 +#define KEY_each 41 +#define KEY_else 42 +#define KEY_elsif 43 +#define KEY_endgrent 44 +#define KEY_endhostent 45 +#define KEY_endnetent 46 +#define KEY_endprotoent 47 +#define KEY_endpwent 48 +#define KEY_endservent 49 +#define KEY_eof 50 +#define KEY_eq 51 +#define KEY_eval 52 +#define KEY_exec 53 +#define KEY_exit 54 +#define KEY_exp 55 +#define KEY_fcntl 56 +#define KEY_fileno 57 +#define KEY_flock 58 +#define KEY_for 59 +#define KEY_foreach 60 +#define KEY_fork 61 +#define KEY_format 62 +#define KEY_formline 63 +#define KEY_ge 64 +#define KEY_getc 65 +#define KEY_getgrent 66 +#define KEY_getgrgid 67 +#define KEY_getgrnam 68 +#define KEY_gethostbyaddr 69 +#define KEY_gethostbyname 70 +#define KEY_gethostent 71 +#define KEY_getlogin 72 +#define KEY_getnetbyaddr 73 +#define KEY_getnetbyname 74 +#define KEY_getnetent 75 +#define KEY_getpeername 76 +#define KEY_getpgrp 77 +#define KEY_getppid 78 +#define KEY_getpriority 79 +#define KEY_getprotobyname 80 +#define KEY_getprotobynumber 81 +#define KEY_getprotoent 82 +#define KEY_getpwent 83 +#define KEY_getpwnam 84 +#define KEY_getpwuid 85 +#define KEY_getservbyname 86 +#define KEY_getservbyport 87 +#define KEY_getservent 88 +#define KEY_getsockname 89 +#define KEY_getsockopt 90 +#define KEY_glob 91 +#define KEY_gmtime 92 +#define KEY_goto 93 +#define KEY_grep 94 +#define KEY_gt 95 +#define KEY_hex 96 +#define KEY_if 97 +#define KEY_index 98 +#define KEY_int 99 +#define KEY_ioctl 100 +#define KEY_join 101 +#define KEY_keys 102 +#define KEY_kill 103 +#define KEY_last 104 +#define KEY_lc 105 +#define KEY_lcfirst 106 +#define KEY_le 107 +#define KEY_length 108 +#define KEY_link 109 +#define KEY_listen 110 +#define KEY_local 111 +#define KEY_localtime 112 +#define KEY_log 113 +#define KEY_lstat 114 +#define KEY_lt 115 +#define KEY_m 116 +#define KEY_mkdir 117 +#define KEY_msgctl 118 +#define KEY_msgget 119 +#define KEY_msgrcv 120 +#define KEY_msgsnd 121 +#define KEY_my 122 +#define KEY_ne 123 +#define KEY_next 124 +#define KEY_oct 125 +#define KEY_open 126 +#define KEY_opendir 127 +#define KEY_or 128 +#define KEY_ord 129 +#define KEY_pack 130 +#define KEY_package 131 +#define KEY_pipe 132 +#define KEY_pop 133 +#define KEY_print 134 +#define KEY_printf 135 +#define KEY_push 136 +#define KEY_q 137 +#define KEY_qq 138 +#define KEY_qx 139 +#define KEY_rand 140 +#define KEY_read 141 +#define KEY_readdir 142 +#define KEY_readline 143 +#define KEY_readlink 144 +#define KEY_readpipe 145 #define KEY_recv 146 -#define KEY_reverse 147 -#define KEY_readline 148 -#define KEY_readlink 149 -#define KEY_readpipe 150 -#define KEY_s 151 -#define KEY_scalar 152 -#define KEY_select 153 -#define KEY_seek 154 -#define KEY_semctl 155 -#define KEY_semget 156 -#define KEY_semop 157 -#define KEY_send 158 -#define KEY_setpgrp 159 -#define KEY_setpriority 160 -#define KEY_sethostent 161 -#define KEY_setnetent 162 -#define KEY_setservent 163 -#define KEY_setprotoent 164 -#define KEY_setpwent 165 +#define KEY_redo 147 +#define KEY_ref 148 +#define KEY_rename 149 +#define KEY_require 150 +#define KEY_reset 151 +#define KEY_return 152 +#define KEY_reverse 153 +#define KEY_rewinddir 154 +#define KEY_rindex 155 +#define KEY_rmdir 156 +#define KEY_s 157 +#define KEY_scalar 158 +#define KEY_seek 159 +#define KEY_seekdir 160 +#define KEY_select 161 +#define KEY_semctl 162 +#define KEY_semget 163 +#define KEY_semop 164 +#define KEY_send 165 #define KEY_setgrent 166 -#define KEY_seekdir 167 -#define KEY_setsockopt 168 -#define KEY_shift 169 -#define KEY_shmctl 170 -#define KEY_shmget 171 -#define KEY_shmread 172 -#define KEY_shmwrite 173 -#define KEY_shutdown 174 -#define KEY_sin 175 -#define KEY_sleep 176 -#define KEY_socket 177 -#define KEY_socketpair 178 -#define KEY_sort 179 -#define KEY_split 180 -#define KEY_sprintf 181 -#define KEY_splice 182 -#define KEY_sqrt 183 -#define KEY_srand 184 -#define KEY_stat 185 -#define KEY_study 186 -#define KEY_substr 187 -#define KEY_sub 188 -#define KEY_system 189 -#define KEY_symlink 190 -#define KEY_syscall 191 -#define KEY_sysread 192 -#define KEY_syswrite 193 -#define KEY_tr 194 -#define KEY_tell 195 -#define KEY_telldir 196 -#define KEY_time 197 -#define KEY_times 198 -#define KEY_truncate 199 -#define KEY_uc 200 -#define KEY_ucfirst 201 -#define KEY_until 202 -#define KEY_unless 203 -#define KEY_unlink 204 -#define KEY_undef 205 -#define KEY_unpack 206 -#define KEY_utime 207 -#define KEY_umask 208 -#define KEY_unshift 209 -#define KEY_values 210 -#define KEY_vec 211 -#define KEY_while 212 -#define KEY_warn 213 -#define KEY_wait 214 -#define KEY_waitpid 215 -#define KEY_wantarray 216 -#define KEY_write 217 -#define KEY_x 218 -#define KEY_y 219 -#define KEY_BEGIN 220 -#define KEY_END 221 +#define KEY_sethostent 167 +#define KEY_setnetent 168 +#define KEY_setpgrp 169 +#define KEY_setpriority 170 +#define KEY_setprotoent 171 +#define KEY_setpwent 172 +#define KEY_setservent 173 +#define KEY_setsockopt 174 +#define KEY_shift 175 +#define KEY_shmctl 176 +#define KEY_shmget 177 +#define KEY_shmread 178 +#define KEY_shmwrite 179 +#define KEY_shutdown 180 +#define KEY_sin 181 +#define KEY_sleep 182 +#define KEY_socket 183 +#define KEY_socketpair 184 +#define KEY_sort 185 +#define KEY_splice 186 +#define KEY_split 187 +#define KEY_sprintf 188 +#define KEY_sqrt 189 +#define KEY_srand 190 +#define KEY_stat 191 +#define KEY_study 192 +#define KEY_sub 193 +#define KEY_substr 194 +#define KEY_symlink 195 +#define KEY_syscall 196 +#define KEY_sysread 197 +#define KEY_system 198 +#define KEY_syswrite 199 +#define KEY_tell 200 +#define KEY_telldir 201 +#define KEY_tie 202 +#define KEY_time 203 +#define KEY_times 204 +#define KEY_tr 205 +#define KEY_truncate 206 +#define KEY_uc 207 +#define KEY_ucfirst 208 +#define KEY_umask 209 +#define KEY_undef 210 +#define KEY_unless 211 +#define KEY_unlink 212 +#define KEY_unpack 213 +#define KEY_unshift 214 +#define KEY_untie 215 +#define KEY_until 216 +#define KEY_utime 217 +#define KEY_values 218 +#define KEY_vec 219 +#define KEY_wait 220 +#define KEY_waitpid 221 +#define KEY_wantarray 222 +#define KEY_warn 223 +#define KEY_while 224 +#define KEY_write 225 +#define KEY_x 226 +#define KEY_y 227 diff --git a/lib/hostname.pl b/lib/hostname.pl new file mode 100644 index 0000000000..5394c6ec69 --- /dev/null +++ b/lib/hostname.pl @@ -0,0 +1,23 @@ +# From: asherman@fmrco.com (Aaron Sherman) + +sub hostname +{ + local(*P,@tmp,$hostname,$_); + if (open(P,"hostname 2>&1 |") && (@tmp = <P>) && close(P)) + { + chop($hostname = $tmp[$#tmp]); + } + elsif (open(P,"uname -n 2>&1 |") && (@tmp = <P>) && close(P)) + { + chop($hostname = $tmp[$#tmp]); + } + else + { + die "$0: Cannot get hostname from 'hostname' or 'uname -n'\n"; + } + @tmp = (); + close P; # Just in case we failed in an odd spot.... + $hostname; +} + +1; diff --git a/lib/open3.pl b/lib/open3.pl index f3d8138879..1dbe525f68 100644 --- a/lib/open3.pl +++ b/lib/open3.pl @@ -1,6 +1,8 @@ # &open3: Marc Horowitz <marc@mit.edu> # derived mostly from &open2 by tom christiansen, <tchrist@convex.com> # +# $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ +# # usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...); # # spawn the given $cmd and connect rdr for diff --git a/lib/timelocal.pl b/lib/timelocal.pl index 95b47e1ef9..c5d8a92920 100644 --- a/lib/timelocal.pl +++ b/lib/timelocal.pl @@ -37,6 +37,7 @@ CONFIG: { $HR = 60 * $MIN; $DAYS = 24 * $HR; $YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0; + 1; } sub timegm { diff --git a/lib/verbose.pl b/lib/verbose.pl new file mode 100644 index 0000000000..ee6143c98e --- /dev/null +++ b/lib/verbose.pl @@ -0,0 +1,78 @@ +# 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 = ** ; @@ -25,3 +25,30 @@ char **env; exit( exitstatus ); } + +/* Register any extra external extensions */ + +void +perl_init_ext() +{ + char *file = __FILE__; + +#ifdef HAS_DB + newXSUB("DB_File::init", 0, init_DB_File, file); +#endif +#ifdef HAS_NDBM + newXSUB("NDBM_File::init", 0, init_NDBM_File, file); +#endif +#ifdef HAS_GDBM + newXSUB("GDBM_File::init", 0, init_GDBM_File, file); +#endif +#ifdef HAS_SDBM + newXSUB("SDBM_File::init", 0, init_SDBM_File, file); +#endif +#ifdef HAS_ODBM + newXSUB("ODBM_File::init", 0, init_ODBM_File, file); +#endif +#ifdef HAS_DBZ + newXSUB("DBZ_File::init", 0, init_DBZ_File, file); +#endif +} @@ -1,6 +1,12 @@ make: Warning: Both `makefile' and `Makefile' exists -`sh cflags op.o` op.c - CCCMD = cc -c -DDEBUGGING -g -cc -Bstatic main.o perly.o perl.o av.o scope.o op.o doop.o doio.o dolist.o dump.o malloc.o mg.o pp.o regcomp.o regexec.o gv.o sv.o toke.o util.o deb.o run.o hv.o usersub.o -ldbm -lm -lposix -o perl +`sh cflags taint.o` taint.c + CCCMD = cc -c -DDEBUGGING -DHAS_SDBM -g +`sh cflags NDBM_File.o` NDBM_File.c + CCCMD = cc -c -DDEBUGGING -DHAS_SDBM -g +`sh cflags ODBM_File.o` ODBM_File.c + CCCMD = cc -c -DDEBUGGING -DHAS_SDBM -g +`sh cflags SDBM_File.o` SDBM_File.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 echo "" @@ -27,7 +27,7 @@ # # I now supply perly.c with the kits, so don't remake perly.c without byacc -YACC = ../perl-byacc1.8.2/byacc +BYACC = ../perl-byacc1.8.2/byacc CC = cc bin = /usr/local/bin @@ -44,7 +44,7 @@ mallocobj = malloc.o SLN = ln -s RMS = rm -f -libs = -ldbm -lm -lposix +libs = -ldbm -lm -lposix ext/dbm/sdbm/libsdbm.a public = perl @@ -71,29 +71,23 @@ h2 = hv.h op.h opcode.h perl.h regcomp.h regexp.h gv.h sv.h util.h h = $(h1) $(h2) -c1 = av.c cop.c cons.c consop.c doop.c doio.c dolist.c +c1 = av.c cop.c cons.c consop.c doop.c doio.c c2 = eval.c hv.c main.c $(mallocsrc) perl.c pp.c regcomp.c regexec.c -c3 = gv.c sv.c toke.c util.c usersub.c +c3 = gv.c sv.c taint.c toke.c util.c usersub.c c = $(c1) $(c2) $(c3) -s1 = av.c cop.c cons.c consop.c doop.c doio.c dolist.c +s1 = av.c cop.c cons.c consop.c doop.c doio.c s2 = eval.c hv.c main.c perl.c pp.c regcomp.c regexec.c -s3 = gv.c sv.c toke.c util.c usersub.c perly.c +s3 = gv.c sv.c taint.c toke.c util.c usersub.c perly.c saber = $(s1) $(s2) $(s3) -obj1 = av.o scope.o op.o doop.o doio.o dolist.o dump.o +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 toke.o util.o deb.o run.o +obj3 = gv.o sv.o taint.o toke.o util.o deb.o run.o -obj = $(obj1) $(obj2) $(obj3) - -tobj1 = tav.o tcop.o tcons.o tconsop.o tdoop.o tdoio.o tdolist.o tdump.o -tobj2 = teval.o thv.o $(mallocobj) tpp.o tregcomp.o tregexec.o -tobj3 = tgv.o tsv.o ttoke.o tutil.o - -tobj = $(tobj1) $(tobj2) $(tobj3) +obj = $(obj1) $(obj2) $(obj3) NDBM_File.o ODBM_File.o SDBM_File.o lintflags = -hbvxac @@ -108,209 +102,86 @@ SHELL = /bin/sh all: perl -#all: $(public) $(private) $(util) uperl.o $(scripts) +#all: $(public) $(private) $(util) $(scripts) # cd x2p; $(MAKE) all # touch all -# This is the standard version that contains no "taint" checks and is -# used for all scripts that aren't set-id or running under something set-id. -# The $& notation is tells Sequent machines that it can do a parallel make, +# The $& notation tells Sequent machines that it can do a parallel make, # and is harmless otherwise. -perl: $& main.o perly.o perl.o $(obj) hv.o usersub.o - $(CC) -Bstatic $(LARGE) $(CLDFLAGS) main.o perly.o perl.o $(obj) hv.o usersub.o $(libs) -o perl +perl: $& main.o perly.o perl.o $(obj) + $(CC) -Bstatic $(LARGE) $(CLDFLAGS) main.o perly.o perl.o $(obj) $(libs) -o perl echo "" libperl.rlb: libperl.a ranlib libperl.a touch libperl.rlb -libperl.a: $& perly.o perl.o $(obj) hv.o usersub.o - ar rcuv libperl.a $(obj) hv.o perly.o usersub.o +libperl.a: $& perly.o perl.o $(obj) + ar rcuv libperl.a $(obj) perly.o # This version, if specified in Configure, does ONLY those scripts which need # set-id emulation. Suidperl must be setuid root. It contains the "taint" # checks as well as the special code to validate that the script in question # has been invoked correctly. -suidperl: $& sperl.o tmain.o libtperl.rlb - $(CC) $(LARGE) $(CLDFLAGS) sperl.o tmain.o libtperl.a $(libs) -o suidperl - -# This version interprets scripts that are already set-id either via a wrapper -# or through the kernel allowing set-id scripts (bad idea). Taintperl must -# NOT be setuid to root or anything else. The only difference between it -# and normal perl is the presence of the "taint" checks. - -taintperl: $& tmain.o libtperl.rlb - $(CC) $(LARGE) $(CLDFLAGS) tmain.o libtperl.a $(libs) -o taintperl - -libtperl.rlb: libtperl.a - ranlib libtperl.a - touch libtperl.rlb - -libtperl.a: $& tperly.o tperl.o $(tobj) thv.o usersub.o - ar rcuv libtperl.a $(tobj) thv.o tperly.o usersub.o tperl.o - -# This command assumes that /usr/include/dbz.h and /usr/lib/dbz.o exist. - -dbzperl: $& main.o zhv.o libperl.rlb - $(CC) $(LARGE) $(CLDFLAGS) main.o zhv.o /usr/lib/dbz.o libperl.a $(libs) -o dbzperl - -zhv.o: hv.c $(h) - $(RMS) zhv.c - $(SLN) hv.c zhv.c - $(CCCMD) -DWANT_DBZ zhv.c - $(RMS) zhv.c - -uperl.o: $& $(obj) main.o hv.o perly.o - -ld $(LARGE) $(LDFLAGS) -r $(obj) main.o hv.o perly.o -o uperl.o +suidperl: $& sperl.o main.o libperl.rlb + $(CC) $(LARGE) $(CLDFLAGS) sperl.o main.o libperl.a $(libs) -o suidperl saber: $(saber) # load $(saber) # load /lib/libm.a -# Replicating all this junk is yucky, but I don't see a portable way to fix it. - -tperly.o: perly.c perly.h $(h) - $(RMS) tperly.c - $(SLN) perly.c tperly.c - $(CCCMD) -DTAINT tperly.c - $(RMS) tperly.c - -tperl.o: perl.c perly.h patchlevel.h perl.h $(h) - $(RMS) tperl.c - $(SLN) perl.c tperl.c - $(CCCMD) -DTAINT tperl.c - $(RMS) tperl.c - sperl.o: perl.c perly.h patchlevel.h $(h) $(RMS) sperl.c $(SLN) perl.c sperl.c $(CCCMD) -DTAINT -DIAMSUID sperl.c $(RMS) sperl.c -tav.o: av.c $(h) - $(RMS) tav.c - $(SLN) av.c tav.c - $(CCCMD) -DTAINT tav.c - $(RMS) tav.c - -tcop.o: cop.c $(h) - $(RMS) tcop.c - $(SLN) cop.c tcop.c - $(CCCMD) -DTAINT tcop.c - $(RMS) tcop.c - -tcons.o: cons.c $(h) perly.h - $(RMS) tcons.c - $(SLN) cons.c tcons.c - $(CCCMD) -DTAINT tcons.c - $(RMS) tcons.c - -tconsop.o: consop.c $(h) - $(RMS) tconsop.c - $(SLN) consop.c tconsop.c - $(CCCMD) -DTAINT tconsop.c - $(RMS) tconsop.c - -tdoop.o: doop.c $(h) - $(RMS) tdoop.c - $(SLN) doop.c tdoop.c - $(CCCMD) -DTAINT tdoop.c - $(RMS) tdoop.c - -tdoio.o: doio.c $(h) - $(RMS) tdoio.c - $(SLN) doio.c tdoio.c - $(CCCMD) -DTAINT tdoio.c - $(RMS) tdoio.c +ODBM_File.c: ext/dbm/ODBM_File.xs + ext/xsubpp ext/typemap ext/dbm/ODBM_File.xs >tmp + mv tmp ODBM_File.c -tdolist.o: dolist.c $(h) - $(RMS) tdolist.c - $(SLN) dolist.c tdolist.c - $(CCCMD) -DTAINT tdolist.c - $(RMS) tdolist.c +NDBM_File.c: ext/dbm/NDBM_File.xs + ext/xsubpp ext/typemap ext/dbm/NDBM_File.xs >tmp + mv tmp NDBM_File.c -tdump.o: dump.c $(h) - $(RMS) tdump.c - $(SLN) dump.c tdump.c - $(CCCMD) -DTAINT tdump.c - $(RMS) tdump.c +SDBM_File.c: ext/dbm/SDBM_File.xs + ext/xsubpp ext/typemap ext/dbm/SDBM_File.xs > tmp + mv tmp SDBM_File.c -teval.o: eval.c $(h) - $(RMS) teval.c - $(SLN) eval.c teval.c - $(CCCMD) -DTAINT teval.c - $(RMS) teval.c +GDBM_File.c: ext/dbm/GDBM_File.xs + ext/xsubpp ext/typemap ext/dbm/GDBM_File.xs >tmp + mv tmp GDBM_File.c -thv.o: hv.c $(h) - $(RMS) thv.c - $(SLN) hv.c thv.c - $(CCCMD) -DTAINT thv.c - $(RMS) thv.c +ODBM_File.o: ODBM_File.c + $(CCCMD) ODBM_File.c -tmain.o: main.c $(h) - $(RMS) tmain.c - $(SLN) main.c tmain.c - $(CCCMD) -DTAINT tmain.c - $(RMS) tmain.c +NDBM_File.o: NDBM_File.c + $(CCCMD) NDBM_File.c -tpp.o: pp.c $(h) - $(RMS) tpp.c - $(SLN) pp.c tpp.c - $(CCCMD) -DTAINT tpp.c - $(RMS) tpp.c +SDBM_File.o: SDBM_File.c + $(CCCMD) SDBM_File.c -tregcomp.o: regcomp.c $(h) - $(RMS) tregcomp.c - $(SLN) regcomp.c tregcomp.c - $(CCCMD) -DTAINT tregcomp.c - $(RMS) tregcomp.c +GDBM_File.o: GDBM_File.c + $(CCCMD) GDBM_File.c -tregexec.o: regexec.c $(h) - $(RMS) tregexec.c - $(SLN) regexec.c tregexec.c - $(CCCMD) -DTAINT tregexec.c - $(RMS) tregexec.c - -tgv.o: gv.c $(h) - $(RMS) tgv.c - $(SLN) gv.c tgv.c - $(CCCMD) -DTAINT tgv.c - $(RMS) tgv.c - -tsv.o: sv.c $(h) perly.h - $(RMS) tsv.c - $(SLN) sv.c tsv.c - $(CCCMD) -DTAINT tsv.c - $(RMS) tsv.c - -ttoke.o: toke.c $(h) perly.h - $(RMS) ttoke.c - $(SLN) toke.c ttoke.c - $(CCCMD) -DTAINT ttoke.c - $(RMS) ttoke.c - -tutil.o: util.c $(h) - $(RMS) tutil.c - $(SLN) util.c tutil.c - $(CCCMD) -DTAINT tutil.c - $(RMS) tutil.c +ext/dbm/sdbm/libsdbm.a: ext/dbm/sdbm/sdbm.c ext/dbm/sdbm/sdbm.h + cd ext/dbm/sdbm; $(MAKE) sdbm perly.h: perly.c @ echo Dummy dependency for dumb parallel make touch perly.h +opcode.h: opcode.pl + - opcode.pl + embed.h: embed_h.SH global.var interp.var sh embed_h.SH perly.c: - @ \ -case "$(YACC)" in \ - *bison*) echo 'Expect' 19 shift/reduce and 58 reduce/reduce conflicts;; \ - *) echo 'Expect' 21 shift/reduce and 56 reduce/reduce conflicts;; \ -esac - $(YACC) -d perly.y + @ echo 'Expect' 62 shift/reduce and 62 reduce/reduce conflicts + $(BYACC) -d perly.y sh $(shellflags) ./perly.fixer y.tab.c perly.c mv y.tab.h perly.h echo 'extern YYSTYPE yylval;' >>perly.h @@ -745,55 +616,6 @@ doio.o: regexp.h doio.o: sv.h doio.o: unixish.h doio.o: util.h -dolist.o: -dolist.o: /usr/ucbinclude/ctype.h -dolist.o: /usr/ucbinclude/dirent.h -dolist.o: /usr/ucbinclude/errno.h -dolist.o: /usr/ucbinclude/machine/param.h -dolist.o: /usr/ucbinclude/machine/setjmp.h -dolist.o: /usr/ucbinclude/ndbm.h -dolist.o: /usr/ucbinclude/netinet/in.h -dolist.o: /usr/ucbinclude/setjmp.h -dolist.o: /usr/ucbinclude/stdio.h -dolist.o: /usr/ucbinclude/sys/dirent.h -dolist.o: /usr/ucbinclude/sys/errno.h -dolist.o: /usr/ucbinclude/sys/filio.h -dolist.o: /usr/ucbinclude/sys/ioccom.h -dolist.o: /usr/ucbinclude/sys/ioctl.h -dolist.o: /usr/ucbinclude/sys/param.h -dolist.o: /usr/ucbinclude/sys/signal.h -dolist.o: /usr/ucbinclude/sys/sockio.h -dolist.o: /usr/ucbinclude/sys/stat.h -dolist.o: /usr/ucbinclude/sys/stdtypes.h -dolist.o: /usr/ucbinclude/sys/sysmacros.h -dolist.o: /usr/ucbinclude/sys/time.h -dolist.o: /usr/ucbinclude/sys/times.h -dolist.o: /usr/ucbinclude/sys/ttold.h -dolist.o: /usr/ucbinclude/sys/ttychars.h -dolist.o: /usr/ucbinclude/sys/ttycom.h -dolist.o: /usr/ucbinclude/sys/ttydev.h -dolist.o: /usr/ucbinclude/sys/types.h -dolist.o: /usr/ucbinclude/time.h -dolist.o: /usr/ucbinclude/vm/faultcode.h -dolist.o: EXTERN.h -dolist.o: av.h -dolist.o: config.h -dolist.o: cop.h -dolist.o: dolist.c -dolist.o: embed.h -dolist.o: form.h -dolist.o: gv.h -dolist.o: handy.h -dolist.o: hv.h -dolist.o: op.h -dolist.o: opcode.h -dolist.o: perl.h -dolist.o: pp.h -dolist.o: proto.h -dolist.o: regexp.h -dolist.o: sv.h -dolist.o: unixish.h -dolist.o: util.h dump.o: dump.o: /usr/ucbinclude/ctype.h dump.o: /usr/ucbinclude/dirent.h @@ -143,7 +143,7 @@ malloc(nbytes) #endif /* MSDOS */ #ifdef DEBUGGING if ((long)nbytes < 0) - fatal("panic: malloc"); + croak("panic: malloc"); #endif #endif /* safemalloc */ @@ -363,7 +363,7 @@ realloc(mp, nbytes) return malloc(nbytes); #ifdef DEBUGGING if ((long)nbytes < 0) - fatal("panic: realloc"); + croak("panic: realloc"); #endif #endif /* safemalloc */ @@ -16,11 +16,23 @@ mg_get(sv) SV* sv; { MAGIC* mg; + + 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); + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl && vtbl->svt_get) (*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) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + return 0; } @@ -29,11 +41,24 @@ mg_set(sv) SV* sv; { MAGIC* mg; - for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { + MAGIC* nextmg; + + SvMAGICAL_off(sv); + + for (mg = SvMAGIC(sv); mg; mg = nextmg) { MGVTBL* vtbl = mg->mg_virtual; + nextmg = mg->mg_moremagic; /* it may delete itself */ if (vtbl && vtbl->svt_set) (*vtbl->svt_set)(sv, mg); } + + 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); + } + return 0; } @@ -42,17 +67,28 @@ mg_len(sv) SV* sv; { MAGIC* mg; + char *s; + STRLEN len; + + 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); + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl && vtbl->svt_len) return (*vtbl->svt_len)(sv, mg); } mg_get(sv); - if (!SvPOK(sv) && SvNIOK(sv)) - sv_2pv(sv); - if (SvPOK(sv)) - return SvCUR(sv); - return 0; + 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); + + return len; } int @@ -60,11 +96,23 @@ mg_clear(sv) SV* sv; { MAGIC* mg; + + 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); + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl && vtbl->svt_clear) (*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); + return 0; } @@ -74,7 +122,6 @@ SV* sv; char type; { MAGIC* mg; - MAGIC** mgp = &SvMAGIC(sv); for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { if (mg->mg_type == type) return mg; @@ -83,30 +130,25 @@ char type; } int -mg_free(sv, type) +mg_copy(sv, nsv, key, klen) SV* sv; -char type; +SV* nsv; +char *key; +STRLEN klen; { + int count = 0; MAGIC* mg; - MAGIC** mgp = &SvMAGIC(sv); - for (mg = *mgp; mg; mg = *mgp) { - if (mg->mg_type == type) { - MGVTBL* vtbl = mg->mg_virtual; - *mgp = mg->mg_moremagic; - if (vtbl && vtbl->svt_free) - (*vtbl->svt_free)(sv, mg); - if (mg->mg_ptr && mg->mg_type != 'g') - Safefree(mg->mg_ptr); - Safefree(mg); + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { + if (isUPPER(mg->mg_type)) { + sv_magic(nsv, mg->mg_obj, tolower(mg->mg_type), key, klen); + count++; } - else - mgp = &mg->mg_moremagic; } - return 0; + return count; } int -mg_freeall(sv) +mg_free(sv) SV* sv; { MAGIC* mg; @@ -118,6 +160,7 @@ SV* sv; (*vtbl->svt_free)(sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') Safefree(mg->mg_ptr); + sv_free(mg->mg_obj); Safefree(mg); } SvMAGIC(sv) = 0; @@ -201,7 +244,7 @@ MAGIC *mg; } magic_get(sv,mg); if (!SvPOK(sv) && SvNIOK(sv)) - sv_2pv(sv); + sv_2pv(sv, &na); if (SvPOK(sv)) return SvCUR(sv); return 0; @@ -405,23 +448,23 @@ MAGIC* mg; { register char *s; I32 i; - s = SvPV(sv); + s = SvPVX(sv); my_setenv(mg->mg_ptr,s); /* And you'll never guess what the dog had */ /* in its mouth... */ -#ifdef TAINT - if (s && strEQ(mg->mg_ptr,"PATH")) { - char *strend = SvEND(sv); - - while (s < strend) { - s = cpytill(tokenbuf,s,strend,':',&i); - s++; - if (*tokenbuf != '/' - || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) ) - sv->sv_tainted = 2; + if (tainting) { + if (s && strEQ(mg->mg_ptr,"PATH")) { + char *strend = SvEND(sv); + + while (s < strend) { + s = cpytill(tokenbuf,s,strend,':',&i); + s++; + if (*tokenbuf != '/' + || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) ) + SvPRIVATE(sv) |= SVp_TAINTEDDIR; + } } } -#endif return 0; } @@ -432,7 +475,7 @@ MAGIC* mg; { register char *s; I32 i; - s = SvPV(sv); + s = SvPVX(sv); 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); @@ -455,12 +498,195 @@ MAGIC* mg; } int -magic_setdbm(sv,mg) +magic_setisa(sv,mg) SV* sv; MAGIC* mg; { - HV* hv = (HV*)mg->mg_obj; - hv_dbmstore(hv,mg->mg_ptr,mg->mg_len,sv); /* XXX slurp? */ + sub_generation++; + return 0; +} + +int +magic_getpack(sv,mg) +SV* sv; +MAGIC* mg; +{ + SV* rv = mg->mg_obj; + HV* stash = SvSTASH((SV*)SvANY(rv)); + GV* gv = gv_fetchmethod(stash, "fetch"); + dSP; + BINOP myop; + + if (!gv || !GvCV(gv)) { + croak("No fetch method for magical variable in package \"%s\"", + HvNAME(stash)); + } + Zero(&myop, 1, BINOP); + myop.op_last = (OP *) &myop; + myop.op_next = Nullop; + myop.op_flags = OPf_STACKED; + + ENTER; + SAVESPTR(op); + op = (OP *) &myop; + PUTBACK; + pp_pushmark(); + + EXTEND(sp, 4); + PUSHs(gv); + PUSHs(rv); + if (mg->mg_ptr) + PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len))); + else if (mg->mg_len >= 0) + PUSHs(sv_mortalcopy(newSViv(mg->mg_len))); + PUTBACK; + + if (op = pp_entersubr()) + run(); + LEAVE; + SPAGAIN; + + sv_setsv(sv, POPs); + PUTBACK; + + return 0; +} + +int +magic_setpack(sv,mg) +SV* sv; +MAGIC* mg; +{ + SV* rv = mg->mg_obj; + HV* stash = SvSTASH((SV*)SvANY(rv)); + GV* gv = gv_fetchmethod(stash, "store"); + dSP; + BINOP myop; + + if (!gv || !GvCV(gv)) { + croak("No store method for magical variable in package \"%s\"", + HvNAME(stash)); + } + Zero(&myop, 1, BINOP); + myop.op_last = (OP *) &myop; + myop.op_next = Nullop; + myop.op_flags = OPf_STACKED; + + ENTER; + SAVESPTR(op); + op = (OP *) &myop; + PUTBACK; + pp_pushmark(); + + EXTEND(sp, 4); + PUSHs(gv); + PUSHs(rv); + if (mg->mg_ptr) + PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len))); + else if (mg->mg_len >= 0) + PUSHs(sv_mortalcopy(newSViv(mg->mg_len))); + PUSHs(sv); + PUTBACK; + + if (op = pp_entersubr()) + run(); + LEAVE; + SPAGAIN; + + POPs; + PUTBACK; + + return 0; +} + +int +magic_clearpack(sv,mg) +SV* sv; +MAGIC* mg; +{ + SV* rv = mg->mg_obj; + HV* stash = SvSTASH((SV*)SvANY(rv)); + GV* gv = gv_fetchmethod(stash, "delete"); + dSP; + BINOP myop; + + if (!gv || !GvCV(gv)) { + croak("No delete method for magical variable in package \"%s\"", + HvNAME(stash)); + } + Zero(&myop, 1, BINOP); + myop.op_last = (OP *) &myop; + myop.op_next = Nullop; + myop.op_flags = OPf_STACKED; + + ENTER; + SAVESPTR(op); + op = (OP *) &myop; + PUTBACK; + pp_pushmark(); + + EXTEND(sp, 4); + PUSHs(gv); + PUSHs(rv); + if (mg->mg_ptr) + PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len))); + else + PUSHs(sv_mortalcopy(newSViv(mg->mg_len))); + PUTBACK; + + if (op = pp_entersubr()) + run(); + LEAVE; + SPAGAIN; + + sv_setsv(sv, POPs); + PUTBACK; + + return 0; +} + +int +magic_nextpack(sv,mg,key) +SV* sv; +MAGIC* mg; +SV* key; +{ + SV* rv = mg->mg_obj; + HV* stash = SvSTASH((SV*)SvANY(rv)); + GV* gv = gv_fetchmethod(stash, SvOK(key) ? "nextkey" : "firstkey"); + dSP; + BINOP myop; + + if (!gv || !GvCV(gv)) { + croak("No fetch method for magical variable in package \"%s\"", + HvNAME(stash)); + } + Zero(&myop, 1, BINOP); + myop.op_last = (OP *) &myop; + myop.op_next = Nullop; + myop.op_flags = OPf_STACKED; + + ENTER; + SAVESPTR(op); + op = (OP *) &myop; + PUTBACK; + pp_pushmark(); + + EXTEND(sp, 4); + PUSHs(gv); + PUSHs(rv); + if (SvOK(key)) + PUSHs(key); + PUTBACK; + + if (op = pp_entersubr()) + run(); + LEAVE; + SPAGAIN; + + sv_setsv(key, POPs); + PUTBACK; + return 0; } @@ -498,7 +724,7 @@ magic_setarylen(sv,mg) SV* sv; MAGIC* mg; { - av_fill((AV*)mg->mg_obj, (SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) - arybase); + av_fill((AV*)mg->mg_obj, (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) - arybase); return 0; } @@ -521,7 +747,7 @@ MAGIC* mg; if (!SvOK(sv)) return 0; - s = SvPOK(sv) ? SvPV(sv) : sv_2pv(sv); + s = SvPV(sv, na); if (*s == '*' && s[1]) s++; gv = gv_fetchpv(s,TRUE); @@ -544,7 +770,7 @@ magic_setsubstr(sv,mg) SV* sv; MAGIC* mg; { - char *tmps = SvPV(sv); + char *tmps = SvPVX(sv); if (!tmps) tmps = ""; sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps,SvCUR(sv)); @@ -552,6 +778,25 @@ MAGIC* mg; } int +magic_gettaint(sv,mg) +SV* sv; +MAGIC* mg; +{ + tainted = TRUE; + return 0; +} + +int +magic_settaint(sv,mg) +SV* sv; +MAGIC* mg; +{ + if (!tainted) + sv_unmagic(sv, 't'); + return 0; +} + +int magic_setvec(sv,mg) SV* sv; MAGIC* mg; @@ -575,7 +820,7 @@ magic_setbm(sv,mg) SV* sv; MAGIC* mg; { - mg_free(sv, 'B'); + sv_unmagic(sv, 'B'); SvVALID_off(sv); return 0; } @@ -601,22 +846,22 @@ MAGIC* mg; I32 i; switch (*mg->mg_ptr) { case '\004': /* ^D */ - debug = (SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) | 32768; + debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 32768; DEBUG_x(dump_all()); break; case '\006': /* ^F */ - maxsysfd = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); + maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; case '\t': /* ^I */ if (inplace) Safefree(inplace); if (SvOK(sv)) - inplace = savestr(SvPV(sv)); + inplace = savestr(SvPVX(sv)); else inplace = Nullch; break; case '\020': /* ^P */ - i = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); + i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); if (i != perldb) { if (perldb) oldlastpm = curpm; @@ -626,10 +871,10 @@ MAGIC* mg; perldb = i; break; case '\024': /* ^T */ - basetime = (time_t)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); + basetime = (time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '\027': /* ^W */ - dowarn = (bool)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); + dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '.': if (localizing) @@ -637,40 +882,40 @@ MAGIC* mg; break; case '^': Safefree(GvIO(defoutgv)->top_name); - GvIO(defoutgv)->top_name = s = savestr(SvPV(sv)); + GvIO(defoutgv)->top_name = s = savestr(SvPVX(sv)); GvIO(defoutgv)->top_gv = gv_fetchpv(s,TRUE); break; case '~': Safefree(GvIO(defoutgv)->fmt_name); - GvIO(defoutgv)->fmt_name = s = savestr(SvPV(sv)); + GvIO(defoutgv)->fmt_name = s = savestr(SvPVX(sv)); GvIO(defoutgv)->fmt_gv = gv_fetchpv(s,TRUE); break; case '=': - GvIO(defoutgv)->page_len = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); + GvIO(defoutgv)->page_len = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '-': - GvIO(defoutgv)->lines_left = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); + GvIO(defoutgv)->lines_left = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); if (GvIO(defoutgv)->lines_left < 0L) GvIO(defoutgv)->lines_left = 0L; break; case '%': - GvIO(defoutgv)->page = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); + GvIO(defoutgv)->page = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '|': if (!GvIO(defoutgv)) GvIO(defoutgv) = newIO(); GvIO(defoutgv)->flags &= ~IOf_FLUSH; - if ((SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) != 0) { + if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) { GvIO(defoutgv)->flags |= IOf_FLUSH; } break; case '*': - i = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); + i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); multiline = (i != 0); break; case '/': if (SvPOK(sv)) { - nrs = rs = SvPV(sv); + nrs = rs = SvPVX(sv); nrslen = rslen = SvCUR(sv); if (rspara = !rslen) { nrs = rs = "\n\n"; @@ -686,31 +931,31 @@ MAGIC* mg; case '\\': if (ors) Safefree(ors); - ors = savestr(SvPV(sv)); + ors = savestr(SvPVX(sv)); orslen = SvCUR(sv); break; case ',': if (ofs) Safefree(ofs); - ofs = savestr(SvPV(sv)); + ofs = savestr(SvPVX(sv)); ofslen = SvCUR(sv); break; case '#': if (ofmt) Safefree(ofmt); - ofmt = savestr(SvPV(sv)); + ofmt = savestr(SvPVX(sv)); break; case '[': - arybase = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); + arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; case '?': - statusvalue = U_S(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)); + statusvalue = U_S(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '!': - errno = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); /* will anyone ever use this? */ + errno = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); /* will anyone ever use this? */ break; case '<': - uid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); + uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); if (delaymagic) { delaymagic |= DM_RUID; break; /* don't do magic till later */ @@ -724,13 +969,14 @@ MAGIC* mg; if (uid == euid) /* special case $< = $> */ (void)setuid(uid); else - fatal("setruid() not implemented"); + croak("setruid() not implemented"); #endif #endif - uid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); + uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + tainting |= (euid != uid || egid != gid); break; case '>': - euid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); + euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); if (delaymagic) { delaymagic |= DM_EUID; break; /* don't do magic till later */ @@ -744,13 +990,14 @@ MAGIC* mg; if (euid == uid) /* special case $> = $< */ setuid(euid); else - fatal("seteuid() not implemented"); + croak("seteuid() not implemented"); #endif #endif euid = (I32)geteuid(); + tainting |= (euid != uid || egid != gid); break; case '(': - gid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); + gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); if (delaymagic) { delaymagic |= DM_RGID; break; /* don't do magic till later */ @@ -764,13 +1011,14 @@ MAGIC* mg; if (gid == egid) /* special case $( = $) */ (void)setgid(gid); else - fatal("setrgid() not implemented"); + croak("setrgid() not implemented"); #endif #endif gid = (I32)getgid(); + tainting |= (euid != uid || egid != gid); break; case ')': - egid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv); + egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); if (delaymagic) { delaymagic |= DM_EGID; break; /* don't do magic till later */ @@ -784,13 +1032,14 @@ MAGIC* mg; if (egid == gid) /* special case $) = $( */ (void)setgid(egid); else - fatal("setegid() not implemented"); + croak("setegid() not implemented"); #endif #endif egid = (I32)getegid(); + tainting |= (euid != uid || egid != gid); break; case ':': - chopset = SvPV(sv); + chopset = SvPVX(sv); break; case '0': if (!origalen) { @@ -810,7 +1059,7 @@ MAGIC* mg; } origalen = s - origargv[0]; } - s = SvPV(sv); + s = SvPVX(sv); i = SvCUR(sv); if (i >= origalen) { i = origalen; @@ -869,15 +1118,15 @@ I32 sig; #endif gv = gv_fetchpv( - SvPVnx(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]), - TRUE)), TRUE); + SvPVx(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]), + TRUE), na), TRUE); cv = GvCV(gv); if (!cv && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) { if (sig_name[sig][1] == 'H') - gv = gv_fetchpv(SvPVnx(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE)), + gv = gv_fetchpv(SvPVx(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE), na), TRUE); else - gv = gv_fetchpv(SvPVnx(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE)), + gv = gv_fetchpv(SvPVx(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE), na), TRUE); cv = GvCV(gv); /* gag */ } @@ -24,5 +24,5 @@ struct magic { U8 mg_flags; SV* mg_obj; char* mg_ptr; - U32 mg_len; + I32 mg_len; }; @@ -1 +0,0 @@ -/scalpel/lwall/netperl
\ No newline at end of file @@ -11,8 +11,6 @@ #include "EXTERN.h" #include "perl.h" -extern int yychar; - /* Lowest byte of opargs */ #define OA_MARK 1 #define OA_FOLDCONST 2 @@ -43,54 +41,6 @@ register I32 l; *d = '\0'; } -int -yyerror(s) -char *s; -{ - char tmpbuf[258]; - char tmp2buf[258]; - char *tname = tmpbuf; - - if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 && - oldoldbufptr != oldbufptr && oldbufptr != bufptr) { - while (isSPACE(*oldoldbufptr)) - oldoldbufptr++; - cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr); - sprintf(tname,"next 2 tokens \"%s\"",tmp2buf); - } - else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 && - oldbufptr != bufptr) { - while (isSPACE(*oldbufptr)) - oldbufptr++; - cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr); - sprintf(tname,"next token \"%s\"",tmp2buf); - } - else if (yychar > 255) - tname = "next token ???"; - else if (!yychar || (yychar == ';' && !rsfp)) - (void)strcpy(tname,"at EOF"); - else if ((yychar & 127) == 127) - (void)strcpy(tname,"at end of line"); - else if (yychar < 32) - (void)sprintf(tname,"next char ^%c",yychar+64); - else - (void)sprintf(tname,"next char %c",yychar); - (void)sprintf(buf, "%s at %s line %d, %s\n", - s,SvPV(GvSV(curcop->cop_filegv)),curcop->cop_line,tname); - if (curcop->cop_line == multi_end && multi_start < multi_end) - sprintf(buf+strlen(buf), - " (Might be a runaway multi-line %c%c string starting on line %d)\n", - multi_open,multi_close,multi_start); - if (in_eval) - sv_catpv(GvSV(gv_fetchpv("@",TRUE)),buf); - else - fputs(buf,stderr); - if (++error_count >= 10) - fatal("%s has too many errors.\n", - SvPV(GvSV(curcop->cop_filegv))); - return 0; -} - OP * no_fh_allowed(op) OP *op; @@ -130,12 +80,12 @@ char *name; sv_upgrade(sv, SVt_PVNV); sv_setpv(sv, name); av_store(comppadname, off, sv); - SvNV(sv) = (double)cop_seq; - SvIV(sv) = 99999999; + SvNVX(sv) = (double)cop_seqmax; + SvIVX(sv) = 99999999; if (*name == '@') - av_store(comppad, off, newAV()); + av_store(comppad, off, (SV*)newAV()); else if (*name == '%') - av_store(comppad, off, newHV(COEFFSIZE)); + av_store(comppad, off, (SV*)newHV()); return off; } @@ -152,13 +102,13 @@ char *name; AV *curlist; AV *curname; CV *cv; - I32 seq = cop_seq; + I32 seq = cop_seqmax; for (off = comppadnamefill; off > 0; off--) { if ((sv = svp[off]) && - seq <= SvIV(sv) && - seq > (I32)SvNV(sv) && - strEQ(SvPV(sv), name)) + seq <= SvIVX(sv) && + seq > (I32)SvNVX(sv) && + strEQ(SvPVX(sv), name)) { return (PADOFFSET)off; } @@ -190,9 +140,9 @@ char *name; svp = AvARRAY(curname); for (off = AvFILL(curname); off > 0; off--) { if ((sv = svp[off]) && - seq <= SvIV(sv) && - seq > (I32)SvNV(sv) && - strEQ(SvPV(sv), name)) + seq <= SvIVX(sv) && + seq > (I32)SvNVX(sv) && + strEQ(SvPVX(sv), name)) { PADOFFSET newoff = pad_alloc(OP_PADSV, 'M'); AV *oldpad = (AV*)*av_fetch(curlist, CvDEPTH(cv), FALSE); @@ -201,8 +151,8 @@ char *name; sv_upgrade(sv, SVt_PVNV); sv_setpv(sv, name); av_store(comppadname, newoff, sv); - SvNV(sv) = (double)curcop->cop_seq; - SvIV(sv) = 99999999; + SvNVX(sv) = (double)curcop->cop_seq; + SvIVX(sv) = 99999999; av_store(comppad, newoff, sv_ref(oldsv)); return newoff; } @@ -223,7 +173,7 @@ I32 fill; SV *sv; for (off = AvFILL(comppadname); off > fill; off--) { if (sv = svp[off]) - SvIV(sv) = cop_seq; + SvIVX(sv) = cop_seqmax; } } @@ -236,7 +186,7 @@ char tmptype; I32 retval; if (AvARRAY(comppad) != curpad) - fatal("panic: pad_alloc"); + croak("panic: pad_alloc"); if (tmptype == 'M') { do { sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE); @@ -260,7 +210,7 @@ pad_sv(po) PADOFFSET po; { if (!po) - fatal("panic: pad_sv po"); + croak("panic: pad_sv po"); DEBUG_X(fprintf(stderr, "Pad sv %d\n", po)); return curpad[po]; /* eventually we'll turn this into a macro */ } @@ -270,9 +220,9 @@ pad_free(po) PADOFFSET po; { if (AvARRAY(comppad) != curpad) - fatal("panic: pad_free curpad"); + croak("panic: pad_free curpad"); if (!po) - fatal("panic: pad_free po"); + croak("panic: pad_free po"); DEBUG_X(fprintf(stderr, "Pad free %d\n", po)); if (curpad[po]) SvSTORAGE(curpad[po]) = 'F'; @@ -285,9 +235,9 @@ pad_swipe(po) PADOFFSET po; { if (AvARRAY(comppad) != curpad) - fatal("panic: pad_swipe curpad"); + croak("panic: pad_swipe curpad"); if (!po) - fatal("panic: pad_swipe po"); + croak("panic: pad_swipe po"); DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po)); curpad[po] = NEWSV(0,0); SvSTORAGE(curpad[po]) = 'F'; @@ -301,7 +251,7 @@ pad_reset() register I32 po; if (AvARRAY(comppad) != curpad) - fatal("panic: pad_reset curpad"); + croak("panic: pad_reset curpad"); DEBUG_X(fprintf(stderr, "Pad reset\n")); for (po = AvMAX(comppad); po > 0; po--) { if (curpad[po] && SvSTORAGE(curpad[po]) == 'T') @@ -330,8 +280,9 @@ OP *op; pad_free(op->op_targ); switch (op->op_type) { + case OP_GVSV: case OP_GV: -/*XXX sv_free(cGVOP->op_gv); */ + sv_free((SV*)cGVOP->op_gv); break; case OP_CONST: sv_free(cSVOP->op_sv); @@ -343,7 +294,7 @@ OP *op; /* Contextualizers */ -#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist(o)) +#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o)) OP * linklist(op) @@ -409,6 +360,7 @@ OP *op; if (!(op->op_flags & OPf_KIDS)) return op; break; + case OP_SCOPE: case OP_LEAVE: case OP_LEAVETRY: case OP_LINESEQ: @@ -444,7 +396,8 @@ OP *op; switch (op->op_type) { default: - if (dowarn && (opargs[op->op_type] & OA_FOLDCONST)) + 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; @@ -482,6 +435,7 @@ OP *op; case OP_NULL: if (!(op->op_flags & OPf_KIDS)) break; + case OP_SCOPE: case OP_LEAVE: case OP_LEAVETRY: case OP_LINESEQ: @@ -544,6 +498,7 @@ OP *op; case OP_LIST: listkids(op); break; + case OP_SCOPE: case OP_LEAVE: case OP_LEAVETRY: case OP_LINESEQ: @@ -565,37 +520,42 @@ OP *op; { OP *kid; - if (op && - (op->op_type == OP_LINESEQ || + if (op) { + if (op->op_type == OP_LINESEQ || + op->op_type == OP_SCOPE || op->op_type == OP_LEAVE || - op->op_type == OP_LEAVETRY) ) - { - for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { - if (kid->op_sibling) - scalarvoid(kid); + op->op_type == OP_LEAVETRY) + { + for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { + if (kid->op_sibling) + scalarvoid(kid); + } + curcop = &compiling; } - curcop = &compiling; + op->op_flags &= ~OPf_PARENS; + if (needblockscope) + op->op_flags |= OPf_PARENS; } return op; } OP * -refkids(op, type) +modkids(op, type) OP *op; I32 type; { OP *kid; if (op && op->op_flags & OPf_KIDS) { for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) - ref(kid, type); + mod(kid, type); } return op; } -static I32 refcount; +static I32 modcount; OP * -ref(op, type) +mod(op, type) OP *op; I32 type; { @@ -628,7 +588,7 @@ I32 type; case OP_COND_EXPR: for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) - ref(kid, type); + mod(kid, type); break; case OP_RV2AV: @@ -641,20 +601,134 @@ I32 type; case OP_HSLICE: case OP_NEXTSTATE: case OP_DBSTATE: - refcount = 10000; + modcount = 10000; 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: + modcount++; + break; + + case OP_PUSHMARK: + break; + + case OP_SUBSTR: + case OP_VEC: + op->op_targ = pad_alloc(op->op_type,'M'); + 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_NULL: + if (!(op->op_flags & OPf_KIDS)) + croak("panic: mod"); + mod(cBINOP->op_first, type ? type : op->op_type); + break; + case OP_AELEM: + case OP_HELEM: + mod(cBINOP->op_first, type ? type : op->op_type); + if (type == OP_RV2AV || type == OP_RV2HV) + op->op_private = type; + break; + + 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 */ + case OP_LIST: + for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + mod(kid, 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; +} + +OP * +refkids(op, type) +OP *op; +I32 type; +{ + OP *kid; + if (op && op->op_flags & OPf_KIDS) { + for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) + ref(kid, type); + } + return op; +} + +OP * +ref(op, type) +OP *op; +I32 type; +{ + OP *kid; + SV *sv; + + if (!op) + 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_COND_EXPR: + for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) + ref(kid, type); + break; + + case OP_RV2AV: + case OP_RV2HV: + 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: - refcount++; break; case OP_PUSHMARK: @@ -670,7 +744,7 @@ I32 type; /* FALL THROUGH */ case OP_NULL: if (!(op->op_flags & OPf_KIDS)) - fatal("panic: ref"); + break; ref(cBINOP->op_first, type ? type : op->op_type); break; case OP_AELEM: @@ -680,6 +754,7 @@ I32 type; op->op_private = type; break; + case OP_SCOPE: case OP_LEAVE: case OP_ENTER: if (type != OP_RV2HV && type != OP_RV2AV) @@ -753,7 +828,7 @@ OP *right; right->op_type == OP_TRANS) { right->op_flags |= OPf_STACKED; if (right->op_type != OP_MATCH) - left = ref(left, right->op_type); + left = mod(left, right->op_type); if (right->op_type == OP_TRANS) op = newBINOP(OP_NULL, 0, scalar(left), right); else @@ -782,9 +857,25 @@ scope(o) OP *o; { if (o) { - o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o); - o->op_type = OP_LEAVE; - o->op_ppaddr = ppaddr[OP_LEAVE]; + if (o->op_flags & OPf_PARENS) { + o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o); + o->op_type = OP_LEAVE; + o->op_ppaddr = ppaddr[OP_LEAVE]; + } + else { + if (o->op_type == OP_LINESEQ) { + OP *kid; + 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]; + } + } + else + o = newUNOP(OP_SCOPE, 0, o); + } } return o; } @@ -798,7 +889,7 @@ OP **startp; *startp = 0; return o; } - o = scalarseq(scope(o)); + o = scope(scalarseq(o)); *startp = LINKLIST(o); o->op_next = 0; peep(*startp); @@ -818,7 +909,7 @@ I32 lex; if (lex) return my(o); else - return ref(o, OP_NULL); /* a bit kludgey */ + return mod(o, OP_NULL); /* a bit kludgey */ } OP * @@ -1172,10 +1263,10 @@ OP *repl; PMOP *pm = (PMOP*)op; SV *tstr = ((SVOP*)expr)->op_sv; SV *rstr = ((SVOP*)repl)->op_sv; - register char *t = SvPVn(tstr); - register char *r = SvPVn(rstr); - I32 tlen = SvCUR(tstr); - I32 rlen = SvCUR(rstr); + STRLEN tlen; + STRLEN rlen; + register char *t = SvPV(tstr, tlen); + register char *r = SvPV(rstr, rlen); register I32 i; register I32 j; I32 squash; @@ -1269,21 +1360,25 @@ OP *repl; pm = (PMOP*)op; if (expr->op_type == OP_CONST) { + STRLEN plen; SV *pat = ((SVOP*)expr)->op_sv; - char *p = SvPVn(pat); + char *p = SvPV(pat, plen); if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) { sv_setpvn(pat, "\\s+", 3); - p = SvPVn(pat); + p = SvPV(pat, plen); pm->op_pmflags |= PMf_SKIPWHITE; } - scan_prefix(pm, p, SvCUR(pat)); + scan_prefix(pm, p, plen); if (pm->op_pmshort && (pm->op_pmflags & PMf_SCANFIRST)) fbm_compile(pm->op_pmshort, pm->op_pmflags & PMf_FOLD); - pm->op_pmregexp = regcomp(p, p + SvCUR(pat), pm->op_pmflags & PMf_FOLD); + pm->op_pmregexp = regcomp(p, p + plen, pm->op_pmflags & PMf_FOLD); hoistmust(pm); op_free(expr); } else { + if (pm->op_pmflags & PMf_KEEP) + expr = newUNOP(OP_REGCMAYBE,0,expr); + Newz(1101, rcop, 1, LOGOP); rcop->op_type = OP_REGCOMP; rcop->op_ppaddr = ppaddr[OP_REGCOMP]; @@ -1293,10 +1388,17 @@ OP *repl; rcop->op_other = op; /* establish postfix order */ - rcop->op_next = LINKLIST(expr); - expr->op_next = (OP*)rcop; + if (pm->op_pmflags & PMf_KEEP) { + LINKLIST(expr); + rcop->op_next = expr; + ((UNOP*)expr)->op_first->op_next = (OP*)rcop; + } + else { + rcop->op_next = LINKLIST(expr); + expr->op_next = (OP*)rcop; + } - prepend_elem(op->op_type, scalar(rcop), op); + prepend_elem(op->op_type, scalar((OP*)rcop), op); } if (repl) { @@ -1345,7 +1447,7 @@ OP *repl; rcop->op_next = LINKLIST(repl); repl->op_next = (OP*)rcop; - pm->op_pmreplroot = scalar(rcop); + pm->op_pmreplroot = scalar((OP*)rcop); pm->op_pmreplstart = LINKLIST(rcop); rcop->op_next = 0; } @@ -1369,7 +1471,7 @@ SV *sv; svop->op_next = (OP*)svop; svop->op_flags = flags; if (opargs[type] & OA_RETSCALAR) - scalar(svop); + scalar((OP*)svop); if (opargs[type] & OA_TARGET) svop->op_targ = pad_alloc(type,'T'); return (*check[type])((OP*)svop); @@ -1389,7 +1491,7 @@ GV *gv; gvop->op_next = (OP*)gvop; gvop->op_flags = flags; if (opargs[type] & OA_RETSCALAR) - scalar(gvop); + scalar((OP*)gvop); if (opargs[type] & OA_TARGET) gvop->op_targ = pad_alloc(type,'T'); return (*check[type])((OP*)gvop); @@ -1409,7 +1511,7 @@ char *pv; pvop->op_next = (OP*)pvop; pvop->op_flags = flags; if (opargs[type] & OA_RETSCALAR) - scalar(pvop); + scalar((OP*)pvop); if (opargs[type] & OA_TARGET) pvop->op_targ = pad_alloc(type,'T'); return (*check[type])((OP*)pvop); @@ -1431,7 +1533,7 @@ OP *cont; cvop->op_next = (OP*)cvop; cvop->op_flags = flags; if (opargs[type] & OA_RETSCALAR) - scalar(cvop); + scalar((OP*)cvop); if (opargs[type] & OA_TARGET) cvop->op_targ = pad_alloc(type,'T'); return (*check[type])((OP*)cvop); @@ -1441,25 +1543,17 @@ void package(op) OP *op; { - char tmpbuf[256]; - GV *tmpgv; SV *sv; - char *name; save_hptr(&curstash); save_item(curstname); if (op) { + STRLEN len; + char *name; sv = cSVOP->op_sv; - name = SvPVn(sv); - sv_setpv(curstname,name); - sprintf(tmpbuf,"'_%s",name); - tmpgv = gv_fetchpv(tmpbuf,TRUE); - if (!GvHV(tmpgv)) - GvHV(tmpgv) = newHV(0); - curstash = GvHV(tmpgv); - if (!HvNAME(curstash)) - HvNAME(curstash) = savestr(name); - HvCOEFFSIZE(curstash) = 0; + curstash = fetch_stash(sv,TRUE); + name = SvPV(sv, len); + sv_setpvn(curstname, name, len); op_free(op); } else { @@ -1470,6 +1564,27 @@ OP *op; expect = XBLOCK; } +HV* +fetch_stash(sv,create) +SV *sv; +I32 create; +{ + char tmpbuf[256]; + HV *stash; + GV *tmpgv; + char *name = SvPV(sv, na); + sprintf(tmpbuf,"%s::",name); + tmpgv = gv_fetchpv(tmpbuf,create); + if (!tmpgv) + return 0; + if (!GvHV(tmpgv)) + GvHV(tmpgv) = newHV(); + stash = GvHV(tmpgv); + if (!HvNAME(stash)) + HvNAME(stash) = savestr(name); + return stash; +} + OP * newSLICEOP(flags, subscript, listval) I32 flags; @@ -1525,8 +1640,8 @@ OP *right; OP *op; if (list_assignment(left)) { - refcount = 0; - left = ref(left, OP_AASSIGN); + modcount = 0; + left = mod(left, OP_AASSIGN); if (right && right->op_type == OP_SPLIT) { if ((op = ((LISTOP*)right)->op_first) && op->op_type == OP_PUSHRE) { PMOP *pm = (PMOP*)op; @@ -1540,10 +1655,10 @@ OP *right; } } else { - if (refcount < 10000) { + if (modcount < 10000) { SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv; - if (SvIV(sv) == 0) - sv_setiv(sv, refcount+1); + if (SvIVX(sv) == 0) + sv_setiv(sv, modcount+1); } } } @@ -1589,11 +1704,11 @@ OP *right; right = newOP(OP_UNDEF, 0); if (right->op_type == OP_READLINE) { right->op_flags |= OPf_STACKED; - return newBINOP(OP_NULL, flags, ref(scalar(left), OP_SASSIGN), scalar(right)); + return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right)); } else op = newBINOP(OP_SASSIGN, flags, - scalar(right), ref(scalar(left), OP_SASSIGN) ); + scalar(right), mod(scalar(left), OP_SASSIGN) ); return op; } @@ -1614,8 +1729,11 @@ OP *op; cop->op_private = 0; cop->op_next = (OP*)cop; - cop->cop_label = label; - cop->cop_seq = cop_seq++; + if (label) { + cop->cop_label = label; + needblockscope = TRUE; + } + cop->cop_seq = cop_seqmax++; if (copline == NOLINE) cop->cop_line = curcop->cop_line; @@ -1629,7 +1747,7 @@ OP *op; if (perldb) { SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE); if (svp && *svp != &sv_undef && !SvIOK(*svp)) { - SvIV(*svp) = 1; + SvIVX(*svp) = 1; SvIOK_on(*svp); SvSTASH(*svp) = (HV*)cop; } @@ -1718,6 +1836,8 @@ OP* false; if (!false) return newLOGOP(OP_AND, 0, first, true); + if (!true) + return newLOGOP(OP_OR, 0, first, false); scalar(first); if (first->op_type == OP_CONST) { @@ -1814,21 +1934,28 @@ I32 debuggable; OP *expr; OP *block; { - OP* listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0)); + OP* listop; OP* op; + int once = block && block->op_flags & OPf_SPECIAL && + (block->op_type == OP_ENTERSUBR || block->op_type == OP_NULL); - if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) - expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr); + if (expr) { + if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv)) + return block; /* do {} while 0 does once */ + else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) + expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr); + } + 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); - if (block->op_flags & OPf_SPECIAL && /* skip conditional on do {} ? */ - (block->op_type == OP_ENTERSUBR || block->op_type == OP_NULL)) + if (once && op != listop) op->op_next = ((LOGOP*)cUNOP->op_first)->op_other; op->op_flags |= flags; - return op; + return scope(op); } OP * @@ -1857,11 +1984,16 @@ OP *cont; if (expr) cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0)); - listop = append_list(OP_LINESEQ, block, cont); + listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont); redo = LINKLIST(listop); if (expr) { op = newLOGOP(OP_AND, 0, expr, scalar(listop)); + if (op == expr) { /* oops, it's a while (0) */ + op_free(expr); + op_free((OP*)loop); + return Nullop; /* (listop already freed by newLOGOP) */ + } ((LISTOP*)listop)->op_last->op_next = condop = (op == listop ? redo : LINKLIST(op)); if (!next) @@ -1878,7 +2010,7 @@ OP *cont; loop->op_next = (OP*)loop; } - op = newBINOP(OP_LEAVELOOP, 0, loop, op); + op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op); loop->op_redoop = redo; loop->op_lastop = op; @@ -1914,7 +2046,7 @@ OP*cont; op_free(op); } else - fatal("Can't use %s for loop variable", op_name[sv->op_type]); + croak("Can't use %s for loop variable", op_name[sv->op_type]); } else { sv = newGVOP(OP_GV, 0, defgv); @@ -1928,7 +2060,7 @@ OP*cont; } void -cv_free(cv) +cv_clear(cv) CV *cv; { if (!CvUSERSUB(cv) && CvROOT(cv)) { @@ -1941,12 +2073,11 @@ CV *cv; while (i > 0) { SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); if (svp) - av_free(*svp); + av_free((AV*)*svp); } - av_free(CvPADLIST(cv)); + av_free((AV*)CvPADLIST(cv)); } } - Safefree(cv); } void @@ -1956,11 +2087,12 @@ OP *op; OP *block; { register CV *cv; - char *name = SvPVnx(cSVOP->op_sv); - GV *gv = gv_fetchpv(name,TRUE); + char *name = SvPVx(cSVOP->op_sv, na); + GV *gv = gv_fetchpv(name,2); AV* av; - if (cv = GvCV(gv)) { + sub_generation++; + if ((cv = GvCV(gv)) && !GvCVGEN(gv)) { if (CvDEPTH(cv)) CvDELETED(cv) = TRUE; /* probably an autoloader */ else { @@ -1971,12 +2103,14 @@ OP *block; warn("Subroutine %s redefined",name); curcop->cop_line = oldline; } - cv_free(cv); + sv_free((SV*)cv); } } Newz(101,cv,1,CV); sv_upgrade(cv, SVt_PVCV); + SvREFCNT(cv) = 1; GvCV(gv) = cv; + GvCVGEN(gv) = 0; CvFILEGV(cv) = curcop->cop_filegv; av = newAV(); @@ -2015,7 +2149,7 @@ OP *block; rschar = nrschar; rspara = (nrslen == 2); calllist(beginav); - cv_free(cv); + sv_free((SV*)cv); rs = "\n"; rslen = 1; rschar = '\n'; @@ -2035,13 +2169,13 @@ OP *block; SV *sv; SV *tmpstr = sv_mortalcopy(&sv_undef); - sprintf(buf,"%s:%ld",SvPV(GvSV(curcop->cop_filegv)), subline); + sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), subline); sv = newSVpv(buf,0); sv_catpv(sv,"-"); sprintf(buf,"%ld",(long)curcop->cop_line); sv_catpv(sv,buf); gv_efullname(tmpstr,gv); - hv_store(GvHV(DBsub), SvPV(tmpstr), SvCUR(tmpstr), sv, 0); + hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); } op_free(op); copline = NOLINE; @@ -2049,18 +2183,17 @@ OP *block; } void -newUSUB(name, ix, subaddr, filename) +newXSUB(name, ix, subaddr, filename) char *name; I32 ix; I32 (*subaddr)(); char *filename; { register CV *cv; - GV *gv = gv_fetchpv(name,allgvs); + GV *gv = gv_fetchpv(name,2); - if (!gv) /* unused function */ - return; - if (cv = GvCV(gv)) { + sub_generation++; + if ((cv = GvCV(gv)) && !GvCVGEN(gv)) { if (dowarn) warn("Subroutine %s redefined",name); if (!CvUSERSUB(cv) && CvROOT(cv)) { @@ -2071,7 +2204,9 @@ char *filename; } Newz(101,cv,1,CV); sv_upgrade(cv, SVt_PVCV); + SvREFCNT(cv) = 1; GvCV(gv) = cv; + GvCVGEN(gv) = 0; CvFILEGV(cv) = gv_fetchfile(filename); CvUSERSUB(cv) = subaddr; CvUSERINDEX(cv) = ix; @@ -2101,7 +2236,7 @@ OP *block; AV* av; if (op) - name = SvPVnx(cSVOP->op_sv); + name = SvPVx(cSVOP->op_sv, na); else name = "STDOUT"; gv = gv_fetchpv(name,TRUE); @@ -2113,10 +2248,11 @@ OP *block; warn("Format %s redefined",name); curcop->cop_line = oldline; } - cv_free(cv); + sv_free((SV*)cv); } Newz(101,cv,1,CV); sv_upgrade(cv, SVt_PVFM); + SvREFCNT(cv) = 1; GvFORM(gv) = cv; CvFILEGV(cv) = curcop->cop_filegv; @@ -2232,7 +2368,7 @@ OP * oopsCV(o) OP *o; { - fatal("NOT IMPL LINE %d",__LINE__); + croak("NOT IMPL LINE %d",__LINE__); /* STUB */ return o; } @@ -2278,7 +2414,7 @@ OP *op; { if (op->op_flags & OPf_KIDS) { OP* newop; - op = refkids(ck_fun(op), op->op_type); + op = modkids(ck_fun(op), op->op_type); if (op->op_private != 1) return op; newop = cUNOP->op_first->op_sibling; @@ -2312,6 +2448,7 @@ OP * ck_eval(op) OP *op; { + needblockscope = TRUE; if (op->op_flags & OPf_KIDS) { SVOP *kid = (SVOP*)cUNOP->op_first; @@ -2335,7 +2472,7 @@ OP *op; /* establish postfix order */ enter->op_next = (OP*)enter; - op = prepend_elem(OP_LINESEQ, enter, kid); + op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid); op->op_type = OP_LEAVETRY; op->op_ppaddr = ppaddr[OP_LEAVETRY]; enter->op_other = op; @@ -2354,14 +2491,16 @@ ck_exec(op) OP *op; { OP *kid; - op = ck_fun(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]; } } + else + op = listkids(op); return op; } @@ -2382,8 +2521,8 @@ register OP *op; SVOP *kid = (SVOP*)cUNOP->op_first; if (kid->op_type == OP_CONST) { kid->op_type = OP_GV; - kid->op_sv = (SV*)gv_fetchpv(SvPVnx(kid->op_sv), - 1+(op->op_type==OP_RV2CV)); + kid->op_sv = sv_ref((SV*)gv_fetchpv(SvPVx(kid->op_sv, na), + 1+(op->op_type==OP_RV2CV))); } return op; } @@ -2409,7 +2548,7 @@ OP *op; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { OP *newop = newGVOP(type, OPf_SPECIAL, - gv_fetchpv(SvPVnx(kid->op_sv), TRUE)); + gv_fetchpv(SvPVx(kid->op_sv, na), TRUE)); op_free(op); return newop; } @@ -2467,26 +2606,34 @@ OP *op; case OA_AVREF: if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { + char *name = SvPVx(((SVOP*)kid)->op_sv, na); OP *newop = newAVREF(newGVOP(OP_GV, 0, - gv_fetchpv(SvPVnx(((SVOP*)kid)->op_sv), TRUE) )); + gv_fetchpv(name, TRUE) )); + if (dowarn) + warn("Array @%s missing the @ in argument %d of %s()", + name, numargs, op_name[op->op_type]); op_free(kid); kid = newop; kid->op_sibling = sibl; *tokid = kid; } - ref(kid, op->op_type); + mod(kid, op->op_type); break; case OA_HVREF: if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { + char *name = SvPVx(((SVOP*)kid)->op_sv, na); OP *newop = newHVREF(newGVOP(OP_GV, 0, - gv_fetchpv(SvPVnx(((SVOP*)kid)->op_sv), TRUE) )); + gv_fetchpv(name, TRUE) )); + if (dowarn) + warn("Hash %%%s missing the %% in argument %d of %s()", + name, numargs, op_name[op->op_type]); op_free(kid); kid = newop; kid->op_sibling = sibl; *tokid = kid; } - ref(kid, op->op_type); + mod(kid, op->op_type); break; case OA_CVREF: { @@ -2504,7 +2651,7 @@ OP *op; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { OP *newop = newGVOP(OP_GV, 0, - gv_fetchpv(SvPVnx(((SVOP*)kid)->op_sv), TRUE) ); + gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE) ); op_free(kid); kid = newop; } @@ -2518,7 +2665,7 @@ OP *op; scalar(kid); break; case OA_SCALARREF: - ref(scalar(kid), op->op_type); + mod(scalar(kid), op->op_type); break; } oa >>= 4; @@ -2566,7 +2713,7 @@ OP *op; return op; kid = cLISTOP->op_first->op_sibling; if (kid->op_type != OP_NULL) - fatal("panic: ck_grep"); + croak("panic: ck_grep"); kid = kUNOP->op_first; Newz(1101, gwop, 1, LOGOP); @@ -2606,7 +2753,7 @@ OP * ck_lfun(op) OP *op; { - return refkids(ck_fun(op), op->op_type); + return modkids(ck_fun(op), op->op_type); } OP * @@ -2673,7 +2820,7 @@ OP * ck_retarget(op) OP *op; { - fatal("NOT IMPL LINE %d",__LINE__); + croak("NOT IMPL LINE %d",__LINE__); /* STUB */ return op; } @@ -2707,7 +2854,7 @@ OP *op; scalar(newGVOP(OP_GV, 0, gv_fetchpv((subline ? "_" : "ARGV"), TRUE) ))))); } - return scalar(refkids(ck_fun(op), type)); + return scalar(modkids(ck_fun(op), type)); } OP * @@ -2716,27 +2863,31 @@ OP *op; { if (op->op_flags & OPf_STACKED) { OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ - kid = kUNOP->op_first; /* get past sv2gv */ - if (kid->op_type == OP_LEAVE) { - OP *k; + OP *k; + kid = kUNOP->op_first; /* get past rv2gv */ + if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) { linklist(kid); - kid->op_type = OP_NULL; /* wipe out leave */ - kid->op_ppaddr = ppaddr[OP_NULL]; - kid->op_next = kid; - - for (k = kLISTOP->op_first->op_next; k; k = k->op_next) { - if (k->op_next == kid) - k->op_next = 0; + if (kid->op_type == OP_SCOPE) { + k = kid->op_next; + kid->op_next = 0; + peep(k); } - kid->op_type = OP_NULL; /* wipe out enter */ - kid->op_ppaddr = ppaddr[OP_NULL]; - - kid = cLISTOP->op_first->op_sibling; - kid->op_type = OP_NULL; /* wipe out sv2gv */ + else if (kid->op_type == OP_LEAVE) { + kid->op_type = OP_NULL; /* wipe out leave */ + kid->op_ppaddr = ppaddr[OP_NULL]; + kid->op_next = kid; + + for (k = kLISTOP->op_first->op_next; k; k = k->op_next) { + if (k->op_next == kid) + k->op_next = 0; + } + 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]; kid->op_next = kid; - op->op_flags |= OPf_SPECIAL; } } @@ -2762,10 +2913,11 @@ OP *op; kid = cLISTOP->op_first; if (kid->op_type == OP_PUSHMARK) - fatal("panic: ck_split"); + croak("panic: ck_split"); if (kid->op_type != OP_MATCH) { OP *sibl = kid->op_sibling; + kid->op_sibling = 0; kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop); if (cLISTOP->op_first == cLISTOP->op_last) cLISTOP->op_last = kid; @@ -2825,6 +2977,8 @@ OP *op; return ck_fun(op); } +/* A peephole optimizer. We visit the ops in the order they're to execute. */ + void peep(op) register OP* op; @@ -2839,15 +2993,18 @@ register OP* op; case OP_NULL: case OP_SCALAR: case OP_LINESEQ: + case OP_SCOPE: if (oldop) { oldop->op_next = op->op_next; continue; } - op->op_seq = ++op_seq; + op->op_seq = ++op_seqmax; break; case OP_GV: - if (op->op_next->op_type == OP_RV2SV) { + 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; @@ -2855,24 +3012,24 @@ register OP* op; op->op_type = OP_GVSV; op->op_ppaddr = ppaddr[OP_GVSV]; } - op->op_seq = ++op_seq; + op->op_seq = ++op_seqmax; break; case OP_GREPWHILE: case OP_AND: case OP_OR: - op->op_seq = ++op_seq; + op->op_seq = ++op_seqmax; peep(cLOGOP->op_other); break; case OP_COND_EXPR: - op->op_seq = ++op_seq; + op->op_seq = ++op_seqmax; peep(cCONDOP->op_true); peep(cCONDOP->op_false); break; case OP_ENTERLOOP: - op->op_seq = ++op_seq; + op->op_seq = ++op_seqmax; peep(cLOOP->op_redoop); peep(cLOOP->op_nextop); peep(cLOOP->op_lastop); @@ -2880,12 +3037,12 @@ register OP* op; case OP_MATCH: case OP_SUBST: - op->op_seq = ++op_seq; + op->op_seq = ++op_seqmax; peep(cPMOP->op_pmreplroot); break; default: - op->op_seq = ++op_seq; + op->op_seq = ++op_seqmax; break; } oldop = op; @@ -49,6 +49,7 @@ typedef U16 PADOFFSET; #define OPf_KNOW 2 /* Context is known. */ #define OPf_KIDS 4 /* There is a firstborn child. */ #define OPf_PARENS 8 /* This operator was parenthesized. */ + /* (Or block needs explicit scope entry.) */ #define OPf_STACKED 16 /* Some arg is arriving on the stack. */ #define OPf_LVAL 32 /* Certified reference (lvalue). */ #define OPf_INTRO 64 /* Lvalue must be localized */ @@ -24,294 +24,300 @@ typedef enum { OP_GLOB, /* 22 */ OP_READLINE, /* 23 */ OP_RCATLINE, /* 24 */ - OP_REGCOMP, /* 25 */ - OP_MATCH, /* 26 */ - OP_SUBST, /* 27 */ - OP_SUBSTCONT, /* 28 */ - OP_TRANS, /* 29 */ - OP_SASSIGN, /* 30 */ - OP_AASSIGN, /* 31 */ - OP_SCHOP, /* 32 */ - OP_CHOP, /* 33 */ - OP_DEFINED, /* 34 */ - OP_UNDEF, /* 35 */ - OP_STUDY, /* 36 */ - OP_PREINC, /* 37 */ - OP_PREDEC, /* 38 */ - OP_POSTINC, /* 39 */ - OP_POSTDEC, /* 40 */ - OP_POW, /* 41 */ - OP_MULTIPLY, /* 42 */ - OP_DIVIDE, /* 43 */ - OP_MODULO, /* 44 */ - OP_REPEAT, /* 45 */ - OP_ADD, /* 46 */ - OP_INTADD, /* 47 */ - OP_SUBTRACT, /* 48 */ - OP_CONCAT, /* 49 */ - OP_LEFT_SHIFT, /* 50 */ - OP_RIGHT_SHIFT, /* 51 */ - OP_LT, /* 52 */ - OP_GT, /* 53 */ - OP_LE, /* 54 */ - OP_GE, /* 55 */ - OP_EQ, /* 56 */ - OP_NE, /* 57 */ - OP_NCMP, /* 58 */ - OP_SLT, /* 59 */ - OP_SGT, /* 60 */ - OP_SLE, /* 61 */ - OP_SGE, /* 62 */ - OP_SEQ, /* 63 */ - OP_SNE, /* 64 */ - OP_SCMP, /* 65 */ - OP_BIT_AND, /* 66 */ - OP_XOR, /* 67 */ - OP_BIT_OR, /* 68 */ - OP_NEGATE, /* 69 */ - OP_NOT, /* 70 */ - OP_COMPLEMENT, /* 71 */ - OP_ATAN2, /* 72 */ - OP_SIN, /* 73 */ - OP_COS, /* 74 */ - OP_RAND, /* 75 */ - OP_SRAND, /* 76 */ - OP_EXP, /* 77 */ - OP_LOG, /* 78 */ - OP_SQRT, /* 79 */ - OP_INT, /* 80 */ - OP_HEX, /* 81 */ - OP_OCT, /* 82 */ - OP_LENGTH, /* 83 */ - OP_SUBSTR, /* 84 */ - OP_VEC, /* 85 */ - OP_INDEX, /* 86 */ - OP_RINDEX, /* 87 */ - OP_SPRINTF, /* 88 */ - OP_FORMLINE, /* 89 */ - OP_ORD, /* 90 */ - OP_CRYPT, /* 91 */ - OP_UCFIRST, /* 92 */ - OP_LCFIRST, /* 93 */ - OP_UC, /* 94 */ - OP_LC, /* 95 */ - OP_RV2AV, /* 96 */ - OP_AELEMFAST, /* 97 */ - OP_AELEM, /* 98 */ - OP_ASLICE, /* 99 */ - OP_EACH, /* 100 */ - OP_VALUES, /* 101 */ - OP_KEYS, /* 102 */ - OP_DELETE, /* 103 */ - OP_RV2HV, /* 104 */ - OP_HELEM, /* 105 */ - OP_HSLICE, /* 106 */ - OP_UNPACK, /* 107 */ - OP_PACK, /* 108 */ - OP_SPLIT, /* 109 */ - OP_JOIN, /* 110 */ - OP_LIST, /* 111 */ - OP_LSLICE, /* 112 */ - OP_ANONLIST, /* 113 */ - OP_ANONHASH, /* 114 */ - OP_SPLICE, /* 115 */ - OP_PUSH, /* 116 */ - OP_POP, /* 117 */ - OP_SHIFT, /* 118 */ - OP_UNSHIFT, /* 119 */ - OP_SORT, /* 120 */ - OP_REVERSE, /* 121 */ - OP_GREPSTART, /* 122 */ - OP_GREPWHILE, /* 123 */ - OP_RANGE, /* 124 */ - OP_FLIP, /* 125 */ - OP_FLOP, /* 126 */ - OP_AND, /* 127 */ - OP_OR, /* 128 */ - OP_COND_EXPR, /* 129 */ - OP_ANDASSIGN, /* 130 */ - OP_ORASSIGN, /* 131 */ - OP_METHOD, /* 132 */ - OP_ENTERSUBR, /* 133 */ - OP_LEAVESUBR, /* 134 */ - OP_CALLER, /* 135 */ - OP_WARN, /* 136 */ - OP_DIE, /* 137 */ - OP_RESET, /* 138 */ - OP_LINESEQ, /* 139 */ - OP_NEXTSTATE, /* 140 */ - OP_DBSTATE, /* 141 */ - OP_UNSTACK, /* 142 */ - OP_ENTER, /* 143 */ - OP_LEAVE, /* 144 */ - OP_ENTERITER, /* 145 */ - OP_ITER, /* 146 */ - OP_ENTERLOOP, /* 147 */ - OP_LEAVELOOP, /* 148 */ - OP_RETURN, /* 149 */ - OP_LAST, /* 150 */ - OP_NEXT, /* 151 */ - OP_REDO, /* 152 */ - OP_DUMP, /* 153 */ - OP_GOTO, /* 154 */ - OP_EXIT, /* 155 */ - OP_NSWITCH, /* 156 */ - OP_CSWITCH, /* 157 */ - OP_OPEN, /* 158 */ - OP_CLOSE, /* 159 */ - OP_PIPE_OP, /* 160 */ - OP_FILENO, /* 161 */ - OP_UMASK, /* 162 */ - OP_BINMODE, /* 163 */ - OP_DBMOPEN, /* 164 */ - OP_DBMCLOSE, /* 165 */ - OP_SSELECT, /* 166 */ - OP_SELECT, /* 167 */ - OP_GETC, /* 168 */ - OP_READ, /* 169 */ - OP_ENTERWRITE, /* 170 */ - OP_LEAVEWRITE, /* 171 */ - OP_PRTF, /* 172 */ - OP_PRINT, /* 173 */ - OP_SYSREAD, /* 174 */ - OP_SYSWRITE, /* 175 */ - OP_SEND, /* 176 */ - OP_RECV, /* 177 */ - OP_EOF, /* 178 */ - OP_TELL, /* 179 */ - OP_SEEK, /* 180 */ - OP_TRUNCATE, /* 181 */ - OP_FCNTL, /* 182 */ - OP_IOCTL, /* 183 */ - OP_FLOCK, /* 184 */ - OP_SOCKET, /* 185 */ - OP_SOCKPAIR, /* 186 */ - OP_BIND, /* 187 */ - OP_CONNECT, /* 188 */ - OP_LISTEN, /* 189 */ - OP_ACCEPT, /* 190 */ - OP_SHUTDOWN, /* 191 */ - OP_GSOCKOPT, /* 192 */ - OP_SSOCKOPT, /* 193 */ - OP_GETSOCKNAME, /* 194 */ - OP_GETPEERNAME, /* 195 */ - OP_LSTAT, /* 196 */ - OP_STAT, /* 197 */ - OP_FTRREAD, /* 198 */ - OP_FTRWRITE, /* 199 */ - OP_FTREXEC, /* 200 */ - OP_FTEREAD, /* 201 */ - OP_FTEWRITE, /* 202 */ - OP_FTEEXEC, /* 203 */ - OP_FTIS, /* 204 */ - OP_FTEOWNED, /* 205 */ - OP_FTROWNED, /* 206 */ - OP_FTZERO, /* 207 */ - OP_FTSIZE, /* 208 */ - OP_FTMTIME, /* 209 */ - OP_FTATIME, /* 210 */ - OP_FTCTIME, /* 211 */ - OP_FTSOCK, /* 212 */ - OP_FTCHR, /* 213 */ - OP_FTBLK, /* 214 */ - OP_FTFILE, /* 215 */ - OP_FTDIR, /* 216 */ - OP_FTPIPE, /* 217 */ - OP_FTLINK, /* 218 */ - OP_FTSUID, /* 219 */ - OP_FTSGID, /* 220 */ - OP_FTSVTX, /* 221 */ - OP_FTTTY, /* 222 */ - OP_FTTEXT, /* 223 */ - OP_FTBINARY, /* 224 */ - OP_CHDIR, /* 225 */ - OP_CHOWN, /* 226 */ - OP_CHROOT, /* 227 */ - OP_UNLINK, /* 228 */ - OP_CHMOD, /* 229 */ - OP_UTIME, /* 230 */ - OP_RENAME, /* 231 */ - OP_LINK, /* 232 */ - OP_SYMLINK, /* 233 */ - OP_READLINK, /* 234 */ - OP_MKDIR, /* 235 */ - OP_RMDIR, /* 236 */ - OP_OPEN_DIR, /* 237 */ - OP_READDIR, /* 238 */ - OP_TELLDIR, /* 239 */ - OP_SEEKDIR, /* 240 */ - OP_REWINDDIR, /* 241 */ - OP_CLOSEDIR, /* 242 */ - OP_FORK, /* 243 */ - OP_WAIT, /* 244 */ - OP_WAITPID, /* 245 */ - OP_SYSTEM, /* 246 */ - OP_EXEC, /* 247 */ - OP_KILL, /* 248 */ - OP_GETPPID, /* 249 */ - OP_GETPGRP, /* 250 */ - OP_SETPGRP, /* 251 */ - OP_GETPRIORITY, /* 252 */ - OP_SETPRIORITY, /* 253 */ - OP_TIME, /* 254 */ - OP_TMS, /* 255 */ - OP_LOCALTIME, /* 256 */ - OP_GMTIME, /* 257 */ - OP_ALARM, /* 258 */ - OP_SLEEP, /* 259 */ - OP_SHMGET, /* 260 */ - OP_SHMCTL, /* 261 */ - OP_SHMREAD, /* 262 */ - OP_SHMWRITE, /* 263 */ - OP_MSGGET, /* 264 */ - OP_MSGCTL, /* 265 */ - OP_MSGSND, /* 266 */ - OP_MSGRCV, /* 267 */ - OP_SEMGET, /* 268 */ - OP_SEMCTL, /* 269 */ - OP_SEMOP, /* 270 */ - OP_REQUIRE, /* 271 */ - OP_DOFILE, /* 272 */ - OP_ENTEREVAL, /* 273 */ - OP_LEAVEEVAL, /* 274 */ - OP_EVALONCE, /* 275 */ - OP_ENTERTRY, /* 276 */ - OP_LEAVETRY, /* 277 */ - OP_GHBYNAME, /* 278 */ - OP_GHBYADDR, /* 279 */ - OP_GHOSTENT, /* 280 */ - OP_GNBYNAME, /* 281 */ - OP_GNBYADDR, /* 282 */ - OP_GNETENT, /* 283 */ - OP_GPBYNAME, /* 284 */ - OP_GPBYNUMBER, /* 285 */ - OP_GPROTOENT, /* 286 */ - OP_GSBYNAME, /* 287 */ - OP_GSBYPORT, /* 288 */ - OP_GSERVENT, /* 289 */ - OP_SHOSTENT, /* 290 */ - OP_SNETENT, /* 291 */ - OP_SPROTOENT, /* 292 */ - OP_SSERVENT, /* 293 */ - OP_EHOSTENT, /* 294 */ - OP_ENETENT, /* 295 */ - OP_EPROTOENT, /* 296 */ - OP_ESERVENT, /* 297 */ - OP_GPWNAM, /* 298 */ - OP_GPWUID, /* 299 */ - OP_GPWENT, /* 300 */ - OP_SPWENT, /* 301 */ - OP_EPWENT, /* 302 */ - OP_GGRNAM, /* 303 */ - OP_GGRGID, /* 304 */ - OP_GGRENT, /* 305 */ - OP_SGRENT, /* 306 */ - OP_EGRENT, /* 307 */ - OP_GETLOGIN, /* 308 */ - OP_SYSCALL, /* 309 */ + OP_REGCMAYBE, /* 25 */ + OP_REGCOMP, /* 26 */ + OP_MATCH, /* 27 */ + OP_SUBST, /* 28 */ + OP_SUBSTCONT, /* 29 */ + OP_TRANS, /* 30 */ + OP_SASSIGN, /* 31 */ + OP_AASSIGN, /* 32 */ + OP_SCHOP, /* 33 */ + OP_CHOP, /* 34 */ + OP_DEFINED, /* 35 */ + OP_UNDEF, /* 36 */ + OP_STUDY, /* 37 */ + OP_PREINC, /* 38 */ + OP_PREDEC, /* 39 */ + OP_POSTINC, /* 40 */ + OP_POSTDEC, /* 41 */ + OP_POW, /* 42 */ + OP_MULTIPLY, /* 43 */ + OP_DIVIDE, /* 44 */ + OP_MODULO, /* 45 */ + OP_REPEAT, /* 46 */ + OP_ADD, /* 47 */ + OP_INTADD, /* 48 */ + OP_SUBTRACT, /* 49 */ + OP_CONCAT, /* 50 */ + OP_LEFT_SHIFT, /* 51 */ + OP_RIGHT_SHIFT, /* 52 */ + OP_LT, /* 53 */ + OP_GT, /* 54 */ + OP_LE, /* 55 */ + OP_GE, /* 56 */ + OP_EQ, /* 57 */ + OP_NE, /* 58 */ + OP_NCMP, /* 59 */ + OP_SLT, /* 60 */ + OP_SGT, /* 61 */ + OP_SLE, /* 62 */ + OP_SGE, /* 63 */ + OP_SEQ, /* 64 */ + OP_SNE, /* 65 */ + OP_SCMP, /* 66 */ + OP_BIT_AND, /* 67 */ + OP_XOR, /* 68 */ + OP_BIT_OR, /* 69 */ + OP_NEGATE, /* 70 */ + OP_NOT, /* 71 */ + OP_COMPLEMENT, /* 72 */ + OP_ATAN2, /* 73 */ + OP_SIN, /* 74 */ + OP_COS, /* 75 */ + OP_RAND, /* 76 */ + OP_SRAND, /* 77 */ + OP_EXP, /* 78 */ + OP_LOG, /* 79 */ + OP_SQRT, /* 80 */ + OP_INT, /* 81 */ + OP_HEX, /* 82 */ + OP_OCT, /* 83 */ + OP_ABS, /* 84 */ + OP_LENGTH, /* 85 */ + OP_SUBSTR, /* 86 */ + OP_VEC, /* 87 */ + OP_INDEX, /* 88 */ + OP_RINDEX, /* 89 */ + OP_SPRINTF, /* 90 */ + OP_FORMLINE, /* 91 */ + OP_ORD, /* 92 */ + OP_CHR, /* 93 */ + OP_CRYPT, /* 94 */ + OP_UCFIRST, /* 95 */ + OP_LCFIRST, /* 96 */ + OP_UC, /* 97 */ + OP_LC, /* 98 */ + OP_RV2AV, /* 99 */ + OP_AELEMFAST, /* 100 */ + OP_AELEM, /* 101 */ + OP_ASLICE, /* 102 */ + OP_EACH, /* 103 */ + OP_VALUES, /* 104 */ + OP_KEYS, /* 105 */ + OP_DELETE, /* 106 */ + OP_RV2HV, /* 107 */ + OP_HELEM, /* 108 */ + OP_HSLICE, /* 109 */ + OP_UNPACK, /* 110 */ + OP_PACK, /* 111 */ + OP_SPLIT, /* 112 */ + OP_JOIN, /* 113 */ + OP_LIST, /* 114 */ + OP_LSLICE, /* 115 */ + OP_ANONLIST, /* 116 */ + OP_ANONHASH, /* 117 */ + OP_SPLICE, /* 118 */ + OP_PUSH, /* 119 */ + OP_POP, /* 120 */ + OP_SHIFT, /* 121 */ + OP_UNSHIFT, /* 122 */ + OP_SORT, /* 123 */ + OP_REVERSE, /* 124 */ + OP_GREPSTART, /* 125 */ + OP_GREPWHILE, /* 126 */ + OP_RANGE, /* 127 */ + OP_FLIP, /* 128 */ + OP_FLOP, /* 129 */ + OP_AND, /* 130 */ + OP_OR, /* 131 */ + OP_COND_EXPR, /* 132 */ + OP_ANDASSIGN, /* 133 */ + OP_ORASSIGN, /* 134 */ + OP_METHOD, /* 135 */ + OP_ENTERSUBR, /* 136 */ + OP_LEAVESUBR, /* 137 */ + OP_CALLER, /* 138 */ + OP_WARN, /* 139 */ + OP_DIE, /* 140 */ + OP_RESET, /* 141 */ + OP_LINESEQ, /* 142 */ + OP_NEXTSTATE, /* 143 */ + OP_DBSTATE, /* 144 */ + OP_UNSTACK, /* 145 */ + OP_ENTER, /* 146 */ + OP_LEAVE, /* 147 */ + OP_SCOPE, /* 148 */ + OP_ENTERITER, /* 149 */ + OP_ITER, /* 150 */ + OP_ENTERLOOP, /* 151 */ + OP_LEAVELOOP, /* 152 */ + OP_RETURN, /* 153 */ + OP_LAST, /* 154 */ + OP_NEXT, /* 155 */ + OP_REDO, /* 156 */ + OP_DUMP, /* 157 */ + OP_GOTO, /* 158 */ + OP_EXIT, /* 159 */ + OP_NSWITCH, /* 160 */ + OP_CSWITCH, /* 161 */ + OP_OPEN, /* 162 */ + OP_CLOSE, /* 163 */ + OP_PIPE_OP, /* 164 */ + OP_FILENO, /* 165 */ + OP_UMASK, /* 166 */ + OP_BINMODE, /* 167 */ + OP_TIE, /* 168 */ + OP_UNTIE, /* 169 */ + OP_DBMOPEN, /* 170 */ + OP_DBMCLOSE, /* 171 */ + OP_SSELECT, /* 172 */ + OP_SELECT, /* 173 */ + OP_GETC, /* 174 */ + OP_READ, /* 175 */ + OP_ENTERWRITE, /* 176 */ + OP_LEAVEWRITE, /* 177 */ + OP_PRTF, /* 178 */ + OP_PRINT, /* 179 */ + OP_SYSREAD, /* 180 */ + OP_SYSWRITE, /* 181 */ + OP_SEND, /* 182 */ + OP_RECV, /* 183 */ + OP_EOF, /* 184 */ + OP_TELL, /* 185 */ + OP_SEEK, /* 186 */ + OP_TRUNCATE, /* 187 */ + OP_FCNTL, /* 188 */ + OP_IOCTL, /* 189 */ + OP_FLOCK, /* 190 */ + OP_SOCKET, /* 191 */ + OP_SOCKPAIR, /* 192 */ + OP_BIND, /* 193 */ + OP_CONNECT, /* 194 */ + OP_LISTEN, /* 195 */ + OP_ACCEPT, /* 196 */ + OP_SHUTDOWN, /* 197 */ + OP_GSOCKOPT, /* 198 */ + OP_SSOCKOPT, /* 199 */ + OP_GETSOCKNAME, /* 200 */ + OP_GETPEERNAME, /* 201 */ + OP_LSTAT, /* 202 */ + OP_STAT, /* 203 */ + OP_FTRREAD, /* 204 */ + OP_FTRWRITE, /* 205 */ + OP_FTREXEC, /* 206 */ + OP_FTEREAD, /* 207 */ + OP_FTEWRITE, /* 208 */ + OP_FTEEXEC, /* 209 */ + OP_FTIS, /* 210 */ + OP_FTEOWNED, /* 211 */ + OP_FTROWNED, /* 212 */ + OP_FTZERO, /* 213 */ + OP_FTSIZE, /* 214 */ + OP_FTMTIME, /* 215 */ + OP_FTATIME, /* 216 */ + OP_FTCTIME, /* 217 */ + OP_FTSOCK, /* 218 */ + OP_FTCHR, /* 219 */ + OP_FTBLK, /* 220 */ + OP_FTFILE, /* 221 */ + OP_FTDIR, /* 222 */ + OP_FTPIPE, /* 223 */ + OP_FTLINK, /* 224 */ + OP_FTSUID, /* 225 */ + OP_FTSGID, /* 226 */ + OP_FTSVTX, /* 227 */ + OP_FTTTY, /* 228 */ + OP_FTTEXT, /* 229 */ + OP_FTBINARY, /* 230 */ + OP_CHDIR, /* 231 */ + OP_CHOWN, /* 232 */ + OP_CHROOT, /* 233 */ + OP_UNLINK, /* 234 */ + OP_CHMOD, /* 235 */ + OP_UTIME, /* 236 */ + OP_RENAME, /* 237 */ + OP_LINK, /* 238 */ + OP_SYMLINK, /* 239 */ + OP_READLINK, /* 240 */ + OP_MKDIR, /* 241 */ + OP_RMDIR, /* 242 */ + OP_OPEN_DIR, /* 243 */ + OP_READDIR, /* 244 */ + OP_TELLDIR, /* 245 */ + OP_SEEKDIR, /* 246 */ + OP_REWINDDIR, /* 247 */ + OP_CLOSEDIR, /* 248 */ + OP_FORK, /* 249 */ + OP_WAIT, /* 250 */ + OP_WAITPID, /* 251 */ + OP_SYSTEM, /* 252 */ + OP_EXEC, /* 253 */ + OP_KILL, /* 254 */ + OP_GETPPID, /* 255 */ + OP_GETPGRP, /* 256 */ + OP_SETPGRP, /* 257 */ + OP_GETPRIORITY, /* 258 */ + OP_SETPRIORITY, /* 259 */ + OP_TIME, /* 260 */ + OP_TMS, /* 261 */ + OP_LOCALTIME, /* 262 */ + OP_GMTIME, /* 263 */ + OP_ALARM, /* 264 */ + OP_SLEEP, /* 265 */ + OP_SHMGET, /* 266 */ + OP_SHMCTL, /* 267 */ + OP_SHMREAD, /* 268 */ + OP_SHMWRITE, /* 269 */ + OP_MSGGET, /* 270 */ + OP_MSGCTL, /* 271 */ + OP_MSGSND, /* 272 */ + OP_MSGRCV, /* 273 */ + OP_SEMGET, /* 274 */ + OP_SEMCTL, /* 275 */ + OP_SEMOP, /* 276 */ + OP_REQUIRE, /* 277 */ + OP_DOFILE, /* 278 */ + OP_ENTEREVAL, /* 279 */ + OP_LEAVEEVAL, /* 280 */ + OP_EVALONCE, /* 281 */ + OP_ENTERTRY, /* 282 */ + OP_LEAVETRY, /* 283 */ + OP_GHBYNAME, /* 284 */ + OP_GHBYADDR, /* 285 */ + OP_GHOSTENT, /* 286 */ + OP_GNBYNAME, /* 287 */ + OP_GNBYADDR, /* 288 */ + OP_GNETENT, /* 289 */ + OP_GPBYNAME, /* 290 */ + OP_GPBYNUMBER, /* 291 */ + OP_GPROTOENT, /* 292 */ + OP_GSBYNAME, /* 293 */ + OP_GSBYPORT, /* 294 */ + OP_GSERVENT, /* 295 */ + OP_SHOSTENT, /* 296 */ + OP_SNETENT, /* 297 */ + OP_SPROTOENT, /* 298 */ + OP_SSERVENT, /* 299 */ + OP_EHOSTENT, /* 300 */ + OP_ENETENT, /* 301 */ + OP_EPROTOENT, /* 302 */ + OP_ESERVENT, /* 303 */ + OP_GPWNAM, /* 304 */ + OP_GPWUID, /* 305 */ + OP_GPWENT, /* 306 */ + OP_SPWENT, /* 307 */ + OP_EPWENT, /* 308 */ + OP_GGRNAM, /* 309 */ + OP_GGRGID, /* 310 */ + OP_GGRENT, /* 311 */ + OP_SGRENT, /* 312 */ + OP_EGRENT, /* 313 */ + OP_GETLOGIN, /* 314 */ + OP_SYSCALL, /* 315 */ } opcode; -#define MAXO 310 +#define MAXO 316 #ifndef DOINIT extern char *op_name[]; @@ -342,6 +348,7 @@ char *op_name[] = { "glob", "<HANDLE>", "append I/O operator", + "regexp comp once", "regexp compilation", "pattern match", "substitution", @@ -400,6 +407,7 @@ char *op_name[] = { "int", "hex", "oct", + "abs", "length", "substr", "vec", @@ -408,6 +416,7 @@ char *op_name[] = { "sprintf", "formline", "ord", + "chr", "crypt", "upper case first", "lower case first", @@ -462,6 +471,7 @@ char *op_name[] = { "unstack", "block entry", "block exit", + "block", "foreach loop entry", "foreach loop iterator", "loop entry", @@ -481,6 +491,8 @@ char *op_name[] = { "fileno", "umask", "binmode", + "tie", + "untie", "dbmopen", "dbmclose", "select system call", @@ -489,7 +501,7 @@ char *op_name[] = { "read", "write", "write exit", - "prtf", + "printf", "print", "sysread", "syswrite", @@ -656,316 +668,322 @@ OP * ck_split P((OP* op)); OP * ck_subr P((OP* op)); OP * ck_trunc P((OP* op)); -OP * pp_null P((ARGSproto)); -OP * pp_stub P((ARGSproto)); -OP * pp_scalar P((ARGSproto)); -OP * pp_pushmark P((ARGSproto)); -OP * pp_wantarray P((ARGSproto)); -OP * pp_const P((ARGSproto)); -OP * pp_interp P((ARGSproto)); -OP * pp_gvsv P((ARGSproto)); -OP * pp_gv P((ARGSproto)); -OP * pp_padsv P((ARGSproto)); -OP * pp_padav P((ARGSproto)); -OP * pp_padhv P((ARGSproto)); -OP * pp_pushre P((ARGSproto)); -OP * pp_rv2gv P((ARGSproto)); -OP * pp_sv2len P((ARGSproto)); -OP * pp_rv2sv P((ARGSproto)); -OP * pp_av2arylen P((ARGSproto)); -OP * pp_rv2cv P((ARGSproto)); -OP * pp_refgen P((ARGSproto)); -OP * pp_ref P((ARGSproto)); -OP * pp_bless P((ARGSproto)); -OP * pp_backtick P((ARGSproto)); -OP * pp_glob P((ARGSproto)); -OP * pp_readline P((ARGSproto)); -OP * pp_rcatline P((ARGSproto)); -OP * pp_regcomp P((ARGSproto)); -OP * pp_match P((ARGSproto)); -OP * pp_subst P((ARGSproto)); -OP * pp_substcont P((ARGSproto)); -OP * pp_trans P((ARGSproto)); -OP * pp_sassign P((ARGSproto)); -OP * pp_aassign P((ARGSproto)); -OP * pp_schop P((ARGSproto)); -OP * pp_chop P((ARGSproto)); -OP * pp_defined P((ARGSproto)); -OP * pp_undef P((ARGSproto)); -OP * pp_study P((ARGSproto)); -OP * pp_preinc P((ARGSproto)); -OP * pp_predec P((ARGSproto)); -OP * pp_postinc P((ARGSproto)); -OP * pp_postdec P((ARGSproto)); -OP * pp_pow P((ARGSproto)); -OP * pp_multiply P((ARGSproto)); -OP * pp_divide P((ARGSproto)); -OP * pp_modulo P((ARGSproto)); -OP * pp_repeat P((ARGSproto)); -OP * pp_add P((ARGSproto)); -OP * pp_intadd P((ARGSproto)); -OP * pp_subtract P((ARGSproto)); -OP * pp_concat P((ARGSproto)); -OP * pp_left_shift P((ARGSproto)); -OP * pp_right_shift P((ARGSproto)); -OP * pp_lt P((ARGSproto)); -OP * pp_gt P((ARGSproto)); -OP * pp_le P((ARGSproto)); -OP * pp_ge P((ARGSproto)); -OP * pp_eq P((ARGSproto)); -OP * pp_ne P((ARGSproto)); -OP * pp_ncmp P((ARGSproto)); -OP * pp_slt P((ARGSproto)); -OP * pp_sgt P((ARGSproto)); -OP * pp_sle P((ARGSproto)); -OP * pp_sge P((ARGSproto)); -OP * pp_seq P((ARGSproto)); -OP * pp_sne P((ARGSproto)); -OP * pp_scmp P((ARGSproto)); -OP * pp_bit_and P((ARGSproto)); -OP * pp_xor P((ARGSproto)); -OP * pp_bit_or P((ARGSproto)); -OP * pp_negate P((ARGSproto)); -OP * pp_not P((ARGSproto)); -OP * pp_complement P((ARGSproto)); -OP * pp_atan2 P((ARGSproto)); -OP * pp_sin P((ARGSproto)); -OP * pp_cos P((ARGSproto)); -OP * pp_rand P((ARGSproto)); -OP * pp_srand P((ARGSproto)); -OP * pp_exp P((ARGSproto)); -OP * pp_log P((ARGSproto)); -OP * pp_sqrt P((ARGSproto)); -OP * pp_int P((ARGSproto)); -OP * pp_hex P((ARGSproto)); -OP * pp_oct P((ARGSproto)); -OP * pp_length P((ARGSproto)); -OP * pp_substr P((ARGSproto)); -OP * pp_vec P((ARGSproto)); -OP * pp_index P((ARGSproto)); -OP * pp_rindex P((ARGSproto)); -OP * pp_sprintf P((ARGSproto)); -OP * pp_formline P((ARGSproto)); -OP * pp_ord P((ARGSproto)); -OP * pp_crypt P((ARGSproto)); -OP * pp_ucfirst P((ARGSproto)); -OP * pp_lcfirst P((ARGSproto)); -OP * pp_uc P((ARGSproto)); -OP * pp_lc P((ARGSproto)); -OP * pp_rv2av P((ARGSproto)); -OP * pp_aelemfast P((ARGSproto)); -OP * pp_aelem P((ARGSproto)); -OP * pp_aslice P((ARGSproto)); -OP * pp_each P((ARGSproto)); -OP * pp_values P((ARGSproto)); -OP * pp_keys P((ARGSproto)); -OP * pp_delete P((ARGSproto)); -OP * pp_rv2hv P((ARGSproto)); -OP * pp_helem P((ARGSproto)); -OP * pp_hslice P((ARGSproto)); -OP * pp_unpack P((ARGSproto)); -OP * pp_pack P((ARGSproto)); -OP * pp_split P((ARGSproto)); -OP * pp_join P((ARGSproto)); -OP * pp_list P((ARGSproto)); -OP * pp_lslice P((ARGSproto)); -OP * pp_anonlist P((ARGSproto)); -OP * pp_anonhash P((ARGSproto)); -OP * pp_splice P((ARGSproto)); -OP * pp_push P((ARGSproto)); -OP * pp_pop P((ARGSproto)); -OP * pp_shift P((ARGSproto)); -OP * pp_unshift P((ARGSproto)); -OP * pp_sort P((ARGSproto)); -OP * pp_reverse P((ARGSproto)); -OP * pp_grepstart P((ARGSproto)); -OP * pp_grepwhile P((ARGSproto)); -OP * pp_range P((ARGSproto)); -OP * pp_flip P((ARGSproto)); -OP * pp_flop P((ARGSproto)); -OP * pp_and P((ARGSproto)); -OP * pp_or P((ARGSproto)); -OP * pp_cond_expr P((ARGSproto)); -OP * pp_andassign P((ARGSproto)); -OP * pp_orassign P((ARGSproto)); -OP * pp_method P((ARGSproto)); -OP * pp_entersubr P((ARGSproto)); -OP * pp_leavesubr P((ARGSproto)); -OP * pp_caller P((ARGSproto)); -OP * pp_warn P((ARGSproto)); -OP * pp_die P((ARGSproto)); -OP * pp_reset P((ARGSproto)); -OP * pp_lineseq P((ARGSproto)); -OP * pp_nextstate P((ARGSproto)); -OP * pp_dbstate P((ARGSproto)); -OP * pp_unstack P((ARGSproto)); -OP * pp_enter P((ARGSproto)); -OP * pp_leave P((ARGSproto)); -OP * pp_enteriter P((ARGSproto)); -OP * pp_iter P((ARGSproto)); -OP * pp_enterloop P((ARGSproto)); -OP * pp_leaveloop P((ARGSproto)); -OP * pp_return P((ARGSproto)); -OP * pp_last P((ARGSproto)); -OP * pp_next P((ARGSproto)); -OP * pp_redo P((ARGSproto)); -OP * pp_dump P((ARGSproto)); -OP * pp_goto P((ARGSproto)); -OP * pp_exit P((ARGSproto)); -OP * pp_nswitch P((ARGSproto)); -OP * pp_cswitch P((ARGSproto)); -OP * pp_open P((ARGSproto)); -OP * pp_close P((ARGSproto)); -OP * pp_pipe_op P((ARGSproto)); -OP * pp_fileno P((ARGSproto)); -OP * pp_umask P((ARGSproto)); -OP * pp_binmode P((ARGSproto)); -OP * pp_dbmopen P((ARGSproto)); -OP * pp_dbmclose P((ARGSproto)); -OP * pp_sselect P((ARGSproto)); -OP * pp_select P((ARGSproto)); -OP * pp_getc P((ARGSproto)); -OP * pp_read P((ARGSproto)); -OP * pp_enterwrite P((ARGSproto)); -OP * pp_leavewrite P((ARGSproto)); -OP * pp_prtf P((ARGSproto)); -OP * pp_print P((ARGSproto)); -OP * pp_sysread P((ARGSproto)); -OP * pp_syswrite P((ARGSproto)); -OP * pp_send P((ARGSproto)); -OP * pp_recv P((ARGSproto)); -OP * pp_eof P((ARGSproto)); -OP * pp_tell P((ARGSproto)); -OP * pp_seek P((ARGSproto)); -OP * pp_truncate P((ARGSproto)); -OP * pp_fcntl P((ARGSproto)); -OP * pp_ioctl P((ARGSproto)); -OP * pp_flock P((ARGSproto)); -OP * pp_socket P((ARGSproto)); -OP * pp_sockpair P((ARGSproto)); -OP * pp_bind P((ARGSproto)); -OP * pp_connect P((ARGSproto)); -OP * pp_listen P((ARGSproto)); -OP * pp_accept P((ARGSproto)); -OP * pp_shutdown P((ARGSproto)); -OP * pp_gsockopt P((ARGSproto)); -OP * pp_ssockopt P((ARGSproto)); -OP * pp_getsockname P((ARGSproto)); -OP * pp_getpeername P((ARGSproto)); -OP * pp_lstat P((ARGSproto)); -OP * pp_stat P((ARGSproto)); -OP * pp_ftrread P((ARGSproto)); -OP * pp_ftrwrite P((ARGSproto)); -OP * pp_ftrexec P((ARGSproto)); -OP * pp_fteread P((ARGSproto)); -OP * pp_ftewrite P((ARGSproto)); -OP * pp_fteexec P((ARGSproto)); -OP * pp_ftis P((ARGSproto)); -OP * pp_fteowned P((ARGSproto)); -OP * pp_ftrowned P((ARGSproto)); -OP * pp_ftzero P((ARGSproto)); -OP * pp_ftsize P((ARGSproto)); -OP * pp_ftmtime P((ARGSproto)); -OP * pp_ftatime P((ARGSproto)); -OP * pp_ftctime P((ARGSproto)); -OP * pp_ftsock P((ARGSproto)); -OP * pp_ftchr P((ARGSproto)); -OP * pp_ftblk P((ARGSproto)); -OP * pp_ftfile P((ARGSproto)); -OP * pp_ftdir P((ARGSproto)); -OP * pp_ftpipe P((ARGSproto)); -OP * pp_ftlink P((ARGSproto)); -OP * pp_ftsuid P((ARGSproto)); -OP * pp_ftsgid P((ARGSproto)); -OP * pp_ftsvtx P((ARGSproto)); -OP * pp_fttty P((ARGSproto)); -OP * pp_fttext P((ARGSproto)); -OP * pp_ftbinary P((ARGSproto)); -OP * pp_chdir P((ARGSproto)); -OP * pp_chown P((ARGSproto)); -OP * pp_chroot P((ARGSproto)); -OP * pp_unlink P((ARGSproto)); -OP * pp_chmod P((ARGSproto)); -OP * pp_utime P((ARGSproto)); -OP * pp_rename P((ARGSproto)); -OP * pp_link P((ARGSproto)); -OP * pp_symlink P((ARGSproto)); -OP * pp_readlink P((ARGSproto)); -OP * pp_mkdir P((ARGSproto)); -OP * pp_rmdir P((ARGSproto)); -OP * pp_open_dir P((ARGSproto)); -OP * pp_readdir P((ARGSproto)); -OP * pp_telldir P((ARGSproto)); -OP * pp_seekdir P((ARGSproto)); -OP * pp_rewinddir P((ARGSproto)); -OP * pp_closedir P((ARGSproto)); -OP * pp_fork P((ARGSproto)); -OP * pp_wait P((ARGSproto)); -OP * pp_waitpid P((ARGSproto)); -OP * pp_system P((ARGSproto)); -OP * pp_exec P((ARGSproto)); -OP * pp_kill P((ARGSproto)); -OP * pp_getppid P((ARGSproto)); -OP * pp_getpgrp P((ARGSproto)); -OP * pp_setpgrp P((ARGSproto)); -OP * pp_getpriority P((ARGSproto)); -OP * pp_setpriority P((ARGSproto)); -OP * pp_time P((ARGSproto)); -OP * pp_tms P((ARGSproto)); -OP * pp_localtime P((ARGSproto)); -OP * pp_gmtime P((ARGSproto)); -OP * pp_alarm P((ARGSproto)); -OP * pp_sleep P((ARGSproto)); -OP * pp_shmget P((ARGSproto)); -OP * pp_shmctl P((ARGSproto)); -OP * pp_shmread P((ARGSproto)); -OP * pp_shmwrite P((ARGSproto)); -OP * pp_msgget P((ARGSproto)); -OP * pp_msgctl P((ARGSproto)); -OP * pp_msgsnd P((ARGSproto)); -OP * pp_msgrcv P((ARGSproto)); -OP * pp_semget P((ARGSproto)); -OP * pp_semctl P((ARGSproto)); -OP * pp_semop P((ARGSproto)); -OP * pp_require P((ARGSproto)); -OP * pp_dofile P((ARGSproto)); -OP * pp_entereval P((ARGSproto)); -OP * pp_leaveeval P((ARGSproto)); -OP * pp_evalonce P((ARGSproto)); -OP * pp_entertry P((ARGSproto)); -OP * pp_leavetry P((ARGSproto)); -OP * pp_ghbyname P((ARGSproto)); -OP * pp_ghbyaddr P((ARGSproto)); -OP * pp_ghostent P((ARGSproto)); -OP * pp_gnbyname P((ARGSproto)); -OP * pp_gnbyaddr P((ARGSproto)); -OP * pp_gnetent P((ARGSproto)); -OP * pp_gpbyname P((ARGSproto)); -OP * pp_gpbynumber P((ARGSproto)); -OP * pp_gprotoent P((ARGSproto)); -OP * pp_gsbyname P((ARGSproto)); -OP * pp_gsbyport P((ARGSproto)); -OP * pp_gservent P((ARGSproto)); -OP * pp_shostent P((ARGSproto)); -OP * pp_snetent P((ARGSproto)); -OP * pp_sprotoent P((ARGSproto)); -OP * pp_sservent P((ARGSproto)); -OP * pp_ehostent P((ARGSproto)); -OP * pp_enetent P((ARGSproto)); -OP * pp_eprotoent P((ARGSproto)); -OP * pp_eservent P((ARGSproto)); -OP * pp_gpwnam P((ARGSproto)); -OP * pp_gpwuid P((ARGSproto)); -OP * pp_gpwent P((ARGSproto)); -OP * pp_spwent P((ARGSproto)); -OP * pp_epwent P((ARGSproto)); -OP * pp_ggrnam P((ARGSproto)); -OP * pp_ggrgid P((ARGSproto)); -OP * pp_ggrent P((ARGSproto)); -OP * pp_sgrent P((ARGSproto)); -OP * pp_egrent P((ARGSproto)); -OP * pp_getlogin P((ARGSproto)); -OP * pp_syscall P((ARGSproto)); +OP * pp_null P((void)); +OP * pp_stub P((void)); +OP * pp_scalar P((void)); +OP * pp_pushmark P((void)); +OP * pp_wantarray P((void)); +OP * pp_const P((void)); +OP * pp_interp P((void)); +OP * pp_gvsv P((void)); +OP * pp_gv P((void)); +OP * pp_padsv P((void)); +OP * pp_padav P((void)); +OP * pp_padhv P((void)); +OP * pp_pushre P((void)); +OP * pp_rv2gv P((void)); +OP * pp_sv2len P((void)); +OP * pp_rv2sv P((void)); +OP * pp_av2arylen P((void)); +OP * pp_rv2cv P((void)); +OP * pp_refgen P((void)); +OP * pp_ref P((void)); +OP * pp_bless P((void)); +OP * pp_backtick P((void)); +OP * pp_glob P((void)); +OP * pp_readline P((void)); +OP * pp_rcatline P((void)); +OP * pp_regcmaybe P((void)); +OP * pp_regcomp P((void)); +OP * pp_match P((void)); +OP * pp_subst P((void)); +OP * pp_substcont P((void)); +OP * pp_trans P((void)); +OP * pp_sassign P((void)); +OP * pp_aassign P((void)); +OP * pp_schop P((void)); +OP * pp_chop P((void)); +OP * pp_defined P((void)); +OP * pp_undef P((void)); +OP * pp_study P((void)); +OP * pp_preinc P((void)); +OP * pp_predec P((void)); +OP * pp_postinc P((void)); +OP * pp_postdec P((void)); +OP * pp_pow P((void)); +OP * pp_multiply P((void)); +OP * pp_divide P((void)); +OP * pp_modulo P((void)); +OP * pp_repeat P((void)); +OP * pp_add P((void)); +OP * pp_intadd P((void)); +OP * pp_subtract P((void)); +OP * pp_concat P((void)); +OP * pp_left_shift P((void)); +OP * pp_right_shift P((void)); +OP * pp_lt P((void)); +OP * pp_gt P((void)); +OP * pp_le P((void)); +OP * pp_ge P((void)); +OP * pp_eq P((void)); +OP * pp_ne P((void)); +OP * pp_ncmp P((void)); +OP * pp_slt P((void)); +OP * pp_sgt P((void)); +OP * pp_sle P((void)); +OP * pp_sge P((void)); +OP * pp_seq P((void)); +OP * pp_sne P((void)); +OP * pp_scmp P((void)); +OP * pp_bit_and P((void)); +OP * pp_xor P((void)); +OP * pp_bit_or P((void)); +OP * pp_negate P((void)); +OP * pp_not P((void)); +OP * pp_complement P((void)); +OP * pp_atan2 P((void)); +OP * pp_sin P((void)); +OP * pp_cos P((void)); +OP * pp_rand P((void)); +OP * pp_srand P((void)); +OP * pp_exp P((void)); +OP * pp_log P((void)); +OP * pp_sqrt P((void)); +OP * pp_int P((void)); +OP * pp_hex P((void)); +OP * pp_oct P((void)); +OP * pp_abs P((void)); +OP * pp_length P((void)); +OP * pp_substr P((void)); +OP * pp_vec P((void)); +OP * pp_index P((void)); +OP * pp_rindex P((void)); +OP * pp_sprintf P((void)); +OP * pp_formline P((void)); +OP * pp_ord P((void)); +OP * pp_chr P((void)); +OP * pp_crypt P((void)); +OP * pp_ucfirst P((void)); +OP * pp_lcfirst P((void)); +OP * pp_uc P((void)); +OP * pp_lc P((void)); +OP * pp_rv2av P((void)); +OP * pp_aelemfast P((void)); +OP * pp_aelem P((void)); +OP * pp_aslice P((void)); +OP * pp_each P((void)); +OP * pp_values P((void)); +OP * pp_keys P((void)); +OP * pp_delete P((void)); +OP * pp_rv2hv P((void)); +OP * pp_helem P((void)); +OP * pp_hslice P((void)); +OP * pp_unpack P((void)); +OP * pp_pack P((void)); +OP * pp_split P((void)); +OP * pp_join P((void)); +OP * pp_list P((void)); +OP * pp_lslice P((void)); +OP * pp_anonlist P((void)); +OP * pp_anonhash P((void)); +OP * pp_splice P((void)); +OP * pp_push P((void)); +OP * pp_pop P((void)); +OP * pp_shift P((void)); +OP * pp_unshift P((void)); +OP * pp_sort P((void)); +OP * pp_reverse P((void)); +OP * pp_grepstart P((void)); +OP * pp_grepwhile P((void)); +OP * pp_range P((void)); +OP * pp_flip P((void)); +OP * pp_flop P((void)); +OP * pp_and P((void)); +OP * pp_or P((void)); +OP * pp_cond_expr P((void)); +OP * pp_andassign P((void)); +OP * pp_orassign P((void)); +OP * pp_method P((void)); +OP * pp_entersubr P((void)); +OP * pp_leavesubr P((void)); +OP * pp_caller P((void)); +OP * pp_warn P((void)); +OP * pp_die P((void)); +OP * pp_reset P((void)); +OP * pp_lineseq P((void)); +OP * pp_nextstate P((void)); +OP * pp_dbstate P((void)); +OP * pp_unstack P((void)); +OP * pp_enter P((void)); +OP * pp_leave P((void)); +OP * pp_scope P((void)); +OP * pp_enteriter P((void)); +OP * pp_iter P((void)); +OP * pp_enterloop P((void)); +OP * pp_leaveloop P((void)); +OP * pp_return P((void)); +OP * pp_last P((void)); +OP * pp_next P((void)); +OP * pp_redo P((void)); +OP * pp_dump P((void)); +OP * pp_goto P((void)); +OP * pp_exit P((void)); +OP * pp_nswitch P((void)); +OP * pp_cswitch P((void)); +OP * pp_open P((void)); +OP * pp_close P((void)); +OP * pp_pipe_op P((void)); +OP * pp_fileno P((void)); +OP * pp_umask P((void)); +OP * pp_binmode P((void)); +OP * pp_tie P((void)); +OP * pp_untie P((void)); +OP * pp_dbmopen P((void)); +OP * pp_dbmclose P((void)); +OP * pp_sselect P((void)); +OP * pp_select P((void)); +OP * pp_getc P((void)); +OP * pp_read P((void)); +OP * pp_enterwrite P((void)); +OP * pp_leavewrite P((void)); +OP * pp_prtf P((void)); +OP * pp_print P((void)); +OP * pp_sysread P((void)); +OP * pp_syswrite P((void)); +OP * pp_send P((void)); +OP * pp_recv P((void)); +OP * pp_eof P((void)); +OP * pp_tell P((void)); +OP * pp_seek P((void)); +OP * pp_truncate P((void)); +OP * pp_fcntl P((void)); +OP * pp_ioctl P((void)); +OP * pp_flock P((void)); +OP * pp_socket P((void)); +OP * pp_sockpair P((void)); +OP * pp_bind P((void)); +OP * pp_connect P((void)); +OP * pp_listen P((void)); +OP * pp_accept P((void)); +OP * pp_shutdown P((void)); +OP * pp_gsockopt P((void)); +OP * pp_ssockopt P((void)); +OP * pp_getsockname P((void)); +OP * pp_getpeername P((void)); +OP * pp_lstat P((void)); +OP * pp_stat P((void)); +OP * pp_ftrread P((void)); +OP * pp_ftrwrite P((void)); +OP * pp_ftrexec P((void)); +OP * pp_fteread P((void)); +OP * pp_ftewrite P((void)); +OP * pp_fteexec P((void)); +OP * pp_ftis P((void)); +OP * pp_fteowned P((void)); +OP * pp_ftrowned P((void)); +OP * pp_ftzero P((void)); +OP * pp_ftsize P((void)); +OP * pp_ftmtime P((void)); +OP * pp_ftatime P((void)); +OP * pp_ftctime P((void)); +OP * pp_ftsock P((void)); +OP * pp_ftchr P((void)); +OP * pp_ftblk P((void)); +OP * pp_ftfile P((void)); +OP * pp_ftdir P((void)); +OP * pp_ftpipe P((void)); +OP * pp_ftlink P((void)); +OP * pp_ftsuid P((void)); +OP * pp_ftsgid P((void)); +OP * pp_ftsvtx P((void)); +OP * pp_fttty P((void)); +OP * pp_fttext P((void)); +OP * pp_ftbinary P((void)); +OP * pp_chdir P((void)); +OP * pp_chown P((void)); +OP * pp_chroot P((void)); +OP * pp_unlink P((void)); +OP * pp_chmod P((void)); +OP * pp_utime P((void)); +OP * pp_rename P((void)); +OP * pp_link P((void)); +OP * pp_symlink P((void)); +OP * pp_readlink P((void)); +OP * pp_mkdir P((void)); +OP * pp_rmdir P((void)); +OP * pp_open_dir P((void)); +OP * pp_readdir P((void)); +OP * pp_telldir P((void)); +OP * pp_seekdir P((void)); +OP * pp_rewinddir P((void)); +OP * pp_closedir P((void)); +OP * pp_fork P((void)); +OP * pp_wait P((void)); +OP * pp_waitpid P((void)); +OP * pp_system P((void)); +OP * pp_exec P((void)); +OP * pp_kill P((void)); +OP * pp_getppid P((void)); +OP * pp_getpgrp P((void)); +OP * pp_setpgrp P((void)); +OP * pp_getpriority P((void)); +OP * pp_setpriority P((void)); +OP * pp_time P((void)); +OP * pp_tms P((void)); +OP * pp_localtime P((void)); +OP * pp_gmtime P((void)); +OP * pp_alarm P((void)); +OP * pp_sleep P((void)); +OP * pp_shmget P((void)); +OP * pp_shmctl P((void)); +OP * pp_shmread P((void)); +OP * pp_shmwrite P((void)); +OP * pp_msgget P((void)); +OP * pp_msgctl P((void)); +OP * pp_msgsnd P((void)); +OP * pp_msgrcv P((void)); +OP * pp_semget P((void)); +OP * pp_semctl P((void)); +OP * pp_semop P((void)); +OP * pp_require P((void)); +OP * pp_dofile P((void)); +OP * pp_entereval P((void)); +OP * pp_leaveeval P((void)); +OP * pp_evalonce P((void)); +OP * pp_entertry P((void)); +OP * pp_leavetry P((void)); +OP * pp_ghbyname P((void)); +OP * pp_ghbyaddr P((void)); +OP * pp_ghostent P((void)); +OP * pp_gnbyname P((void)); +OP * pp_gnbyaddr P((void)); +OP * pp_gnetent P((void)); +OP * pp_gpbyname P((void)); +OP * pp_gpbynumber P((void)); +OP * pp_gprotoent P((void)); +OP * pp_gsbyname P((void)); +OP * pp_gsbyport P((void)); +OP * pp_gservent P((void)); +OP * pp_shostent P((void)); +OP * pp_snetent P((void)); +OP * pp_sprotoent P((void)); +OP * pp_sservent P((void)); +OP * pp_ehostent P((void)); +OP * pp_enetent P((void)); +OP * pp_eprotoent P((void)); +OP * pp_eservent P((void)); +OP * pp_gpwnam P((void)); +OP * pp_gpwuid P((void)); +OP * pp_gpwent P((void)); +OP * pp_spwent P((void)); +OP * pp_epwent P((void)); +OP * pp_ggrnam P((void)); +OP * pp_ggrgid P((void)); +OP * pp_ggrent P((void)); +OP * pp_sgrent P((void)); +OP * pp_egrent P((void)); +OP * pp_getlogin P((void)); +OP * pp_syscall P((void)); #ifndef DOINIT extern OP * (*ppaddr[])(); @@ -996,6 +1014,7 @@ OP * (*ppaddr[])() = { pp_glob, pp_readline, pp_rcatline, + pp_regcmaybe, pp_regcomp, pp_match, pp_subst, @@ -1054,6 +1073,7 @@ OP * (*ppaddr[])() = { pp_int, pp_hex, pp_oct, + pp_abs, pp_length, pp_substr, pp_vec, @@ -1062,6 +1082,7 @@ OP * (*ppaddr[])() = { pp_sprintf, pp_formline, pp_ord, + pp_chr, pp_crypt, pp_ucfirst, pp_lcfirst, @@ -1116,6 +1137,7 @@ OP * (*ppaddr[])() = { pp_unstack, pp_enter, pp_leave, + pp_scope, pp_enteriter, pp_iter, pp_enterloop, @@ -1135,6 +1157,8 @@ OP * (*ppaddr[])() = { pp_fileno, pp_umask, pp_binmode, + pp_tie, + pp_untie, pp_dbmopen, pp_dbmclose, pp_sselect, @@ -1313,6 +1337,7 @@ OP * (*check[])() = { ck_glob, /* glob */ ck_null, /* readline */ ck_null, /* rcatline */ + ck_fun, /* regcmaybe */ ck_null, /* regcomp */ ck_match, /* match */ ck_null, /* subst */ @@ -1371,6 +1396,7 @@ OP * (*check[])() = { ck_fun, /* int */ ck_fun, /* hex */ ck_fun, /* oct */ + ck_fun, /* abs */ ck_lengthconst, /* length */ ck_fun, /* substr */ ck_fun, /* vec */ @@ -1379,6 +1405,7 @@ OP * (*check[])() = { ck_fun, /* sprintf */ ck_formline, /* formline */ ck_fun, /* ord */ + ck_fun, /* chr */ ck_fun, /* crypt */ ck_fun, /* ucfirst */ ck_fun, /* lcfirst */ @@ -1433,6 +1460,7 @@ OP * (*check[])() = { ck_null, /* unstack */ ck_null, /* enter */ ck_null, /* leave */ + ck_null, /* scope */ ck_null, /* enteriter */ ck_null, /* iter */ ck_null, /* enterloop */ @@ -1452,6 +1480,8 @@ OP * (*check[])() = { ck_fun, /* fileno */ ck_fun, /* umask */ ck_fun, /* binmode */ + ck_fun, /* tie */ + ck_fun, /* untie */ ck_fun, /* dbmopen */ ck_fun, /* dbmclose */ ck_select, /* sselect */ @@ -1624,12 +1654,13 @@ U32 opargs[] = { 0x00000014, /* av2arylen */ 0x00000040, /* rv2cv */ 0x0000020e, /* refgen */ - 0x0000010c, /* ref */ - 0x00000104, /* bless */ + 0x0000090c, /* ref */ + 0x00009104, /* bless */ 0x00000008, /* backtick */ 0x00000008, /* glob */ 0x00000008, /* readline */ 0x00000008, /* rcatline */ + 0x00000104, /* regcmaybe */ 0x00000104, /* regcomp */ 0x00000040, /* match */ 0x00000154, /* subst */ @@ -1688,6 +1719,7 @@ U32 opargs[] = { 0x0000090e, /* int */ 0x0000091c, /* hex */ 0x0000091c, /* oct */ + 0x0000090e, /* abs */ 0x0000011c, /* length */ 0x0009110c, /* substr */ 0x0001111c, /* vec */ @@ -1696,6 +1728,7 @@ U32 opargs[] = { 0x0000210d, /* sprintf */ 0x00002105, /* formline */ 0x0000091e, /* ord */ + 0x0000090e, /* chr */ 0x0000110e, /* crypt */ 0x0000010a, /* ucfirst */ 0x0000010a, /* lcfirst */ @@ -1737,7 +1770,7 @@ U32 opargs[] = { 0x00000000, /* cond_expr */ 0x00000004, /* andassign */ 0x00000004, /* orassign */ - 0x00000048, /* method */ + 0x00000040, /* method */ 0x00000241, /* entersubr */ 0x00000000, /* leavesubr */ 0x00000908, /* caller */ @@ -1750,6 +1783,7 @@ U32 opargs[] = { 0x00000004, /* unstack */ 0x00000000, /* enter */ 0x00000000, /* leave */ + 0x00000000, /* scope */ 0x00000040, /* enteriter */ 0x00000000, /* iter */ 0x00000040, /* enterloop */ @@ -1769,7 +1803,9 @@ U32 opargs[] = { 0x0000061c, /* fileno */ 0x0000091c, /* umask */ 0x00000604, /* binmode */ - 0x0001141c, /* dbmopen */ + 0x00021755, /* tie */ + 0x00000714, /* untie */ + 0x00011414, /* dbmopen */ 0x00000414, /* dbmclose */ 0x00111108, /* sselect */ 0x00000e0c, /* select */ @@ -56,7 +56,7 @@ for (sort keys %ckname) { print "\n"; for (@ops) { - print "OP *\t", &tab(3, "pp_\L$_"), "P((ARGSproto));\n"; + print "OP *\t", &tab(3, "pp_\L$_"), "P((void));\n"; } # Emit ppcode switch array. @@ -182,8 +182,8 @@ 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 -ref reference-type operator ck_fun st S -bless bless ck_fun s S +ref reference-type operator ck_fun st S? +bless bless ck_fun s S S? # Pushy I/O. @@ -194,6 +194,7 @@ rcatline append I/O operator ck_null t # Bindable operators. +regcmaybe regexp comp once ck_fun s S regcomp regexp compilation ck_null s S match pattern match ck_match d subst substitution ck_null dis S @@ -271,6 +272,7 @@ sqrt sqrt ck_fun fst S? int int ck_fun fst S? hex hex ck_fun ist S? oct oct ck_fun ist S? +abs abs ck_fun fst S? # String stuff. @@ -284,6 +286,7 @@ rindex rindex ck_index ist S S S? sprintf sprintf ck_fun mst S L formline formline ck_formline ms S L ord ord ck_fun ifst S? +chr chr ck_fun fst S? crypt crypt ck_fun fst S S ucfirst upper case first ck_fun ft S lcfirst lower case first ck_fun ft S @@ -346,7 +349,7 @@ cond_expr conditional expression ck_null 0 andassign logical and assignment ck_null s orassign logical or assignment ck_null s -method method lookup ck_null dt +method method lookup ck_null d entersubr subroutine entry ck_subr dm L leavesubr subroutine exit ck_null 0 caller caller ck_fun t S? @@ -360,6 +363,7 @@ dbstate debug next statement ck_null s unstack unstack ck_null s enter block entry ck_null 0 leave block exit ck_null 0 +scope block ck_null 0 enteriter foreach loop entry ck_null d iter foreach loop iterator ck_null 0 enterloop loop entry ck_null d @@ -385,7 +389,9 @@ fileno fileno ck_fun ist F umask umask ck_fun ist S? binmode binmode ck_fun s F -dbmopen dbmopen ck_fun ist H S S +tie tie ck_fun idms R S L +untie untie ck_fun is R +dbmopen dbmopen ck_fun is H S S dbmclose dbmclose ck_fun is H sselect select system call ck_select t S S S S @@ -396,7 +402,7 @@ read read ck_fun imst F R S S? enterwrite write ck_fun dis F? leavewrite write exit ck_null 0 -prtf prtf ck_listiob ims F? L +prtf printf ck_listiob ims F? L print print ck_listiob ims F? L sysread sysread ck_fun imst F R S S? @@ -1,6 +1,5 @@ -char rcsid[] = "$RCSfile: perl.c,v $$Revision: 5.0 $$Date: 92/08/07 18:25:50 $\nPatch level: ###\n"; /* - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991, 1992, 1993, 1994 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. @@ -59,6 +58,8 @@ char rcsid[] = "$RCSfile: perl.c,v $$Revision: 5.0 $$Date: 92/08/07 18:25:50 $\n #include "perly.h" #include "patchlevel.h" +char rcsid[] = "$RCSfile: perl.c,v $$Revision: 5.0 $$Date: 92/08/07 18:25:50 $\nPatch level: ###\n"; + #ifdef IAMSUID #ifndef DOSUID #define DOSUID @@ -112,11 +113,11 @@ register PerlInterpreter *sv_interp; SvREADONLY_on(&sv_undef); sv_setpv(&sv_no,No); - SvNVn(&sv_no); + SvNV(&sv_no); SvREADONLY_on(&sv_no); sv_setpv(&sv_yes,Yes); - SvNVn(&sv_yes); + SvNV(&sv_yes); SvREADONLY_on(&sv_yes); #ifdef MSDOS @@ -132,7 +133,7 @@ register PerlInterpreter *sv_interp; #ifdef EMBEDDED chopset = " \n-"; - cmdline = NOLINE; + copline = NOLINE; curcop = &compiling; cxstack_ix = -1; cxstack_max = 128; @@ -148,7 +149,7 @@ register PerlInterpreter *sv_interp; rschar = '\n'; rsfp = Nullfp; rslen = 1; - statname = Nullstr; + statname = Nullsv; tmps_floor = -1; tmps_ix = -1; tmps_max = -1; @@ -158,20 +159,13 @@ register PerlInterpreter *sv_interp; euid = (int)geteuid(); gid = (int)getgid(); egid = (int)getegid(); - sprintf(patchlevel,"%3.3s%2.2d", strchr(rcsid,'4'), PATCHLEVEL); + tainting = (euid != uid || egid != gid); + sprintf(patchlevel,"%3.3s%2.2d", strchr(rcsid,'5'), PATCHLEVEL); (void)sprintf(strchr(rcsid,'#'), "%d\n", PATCHLEVEL); fdpid = newAV(); /* for remembering popen pids by fd */ - pidstatus = newHV(COEFFSIZE);/* for remembering status of dead pids */ - -#ifdef TAINT -#ifndef DOSUID - if (uid == euid && gid == egid) - taintanyway = TRUE; /* running taintperl explicitly */ -#endif -#endif - + pidstatus = newHV();/* for remembering status of dead pids */ } void @@ -213,7 +207,7 @@ char **env; #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW #ifdef IAMSUID #undef IAMSUID - fatal("suidperl is no longer needed since the kernel can now execute\n\ + croak("suidperl is no longer needed since the kernel can now execute\n\ setuid perl scripts securely.\n"); #endif #endif @@ -270,6 +264,7 @@ setuid perl scripts securely.\n"); case 'n': case 'p': case 's': + case 'T': case 'u': case 'U': case 'v': @@ -279,18 +274,16 @@ setuid perl scripts securely.\n"); break; case 'e': -#ifdef TAINT if (euid != uid || egid != gid) - fatal("No -e allowed in setuid scripts"); -#endif + croak("No -e allowed in setuid scripts"); if (!e_fp) { e_tmpname = savestr(TMPPATH); (void)mktemp(e_tmpname); if (!*e_tmpname) - fatal("Can't mktemp()"); + croak("Can't mktemp()"); e_fp = fopen(e_tmpname,"w"); if (!e_fp) - fatal("Cannot open temporary file"); + croak("Cannot open temporary file"); } if (argv[1]) { fputs(argv[1],e_fp); @@ -299,10 +292,7 @@ setuid perl scripts securely.\n"); (void)putc('\n', e_fp); break; case 'I': -#ifdef TAINT - if (euid != uid || egid != gid) - fatal("No -I allowed in setuid scripts"); -#endif + taint_not("-I"); sv_catpv(sv,"-"); sv_catpv(sv,s); sv_catpv(sv," "); @@ -317,18 +307,12 @@ setuid perl scripts securely.\n"); } break; case 'P': -#ifdef TAINT - if (euid != uid || egid != gid) - fatal("No -P allowed in setuid scripts"); -#endif + taint_not("-P"); preprocess = TRUE; s++; goto reswitch; case 'S': -#ifdef TAINT - if (euid != uid || egid != gid) - fatal("No -S allowed in setuid scripts"); -#endif + taint_not("-S"); dosearch = TRUE; s++; goto reswitch; @@ -344,14 +328,14 @@ setuid perl scripts securely.\n"); case 0: break; default: - fatal("Unrecognized switch: -%s",s); + croak("Unrecognized switch: -%s",s); } } switch_end: scriptname = argv[0]; if (e_fp) { if (fflush(e_fp) || ferror(e_fp) || fclose(e_fp)) - fatal("Can't write to temp file for -e: %s", strerror(errno)); + croak("Can't write to temp file for -e: %s", strerror(errno)); argc++,argv--; scriptname = e_tmpname; } @@ -391,9 +375,8 @@ setuid perl scripts securely.\n"); init_context_stack(); - userinit(); /* in case linked C routines want magical variables */ + perl_init_ext(); /* in case linked C routines want magical variables */ - allgvs = TRUE; init_predump_symbols(); init_lexer(); @@ -403,9 +386,9 @@ setuid perl scripts securely.\n"); error_count = 0; if (yyparse() || error_count) { if (minus_c) - fatal("%s had compilation errors.\n", origfilename); + croak("%s had compilation errors.\n", origfilename); else { - fatal("Execution of %s aborted due to compilation errors.\n", + croak("Execution of %s aborted due to compilation errors.\n", origfilename); } } @@ -508,19 +491,25 @@ I32 numargs; /* how many args are pushed on the stack */ BINOP myop; /* fake syntax tree node */ ENTER; + SAVETMPS; SAVESPTR(op); stack_base = AvARRAY(stack); stack_sp = stack_base + sp - numargs - 1; 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 += numargs; - myop.op_last = hasargs ? (OP*)&myop : Nullop; + if (hasargs) { + myop.op_flags = OPf_STACKED; + myop.op_last = (OP*)&myop; + } myop.op_next = Nullop; - op = pp_entersubr(); - run(); + if (op = pp_entersubr()) + run(); + free_tmps(); LEAVE; return stack_sp - stack_base; } @@ -554,7 +543,7 @@ I32 namlen; { register GV *gv; - if (gv = gv_fetchpv(sym,allgvs)) + if (gv = gv_fetchpv(sym,TRUE)) sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen); } @@ -623,19 +612,13 @@ char *s; s++; return s; case 'd': -#ifdef TAINT - if (euid != uid || egid != gid) - fatal("No -d allowed in setuid scripts"); -#endif + taint_not("-d"); perldb = TRUE; s++; return s; case 'D': #ifdef DEBUGGING -#ifdef TAINT - if (euid != uid || egid != gid) - fatal("No -D allowed in setuid scripts"); -#endif + taint_not("-D"); if (isALPHA(s[1])) { static char debopts[] = "psltocPmfrxuLHX"; char *d; @@ -663,15 +646,12 @@ char *s; *s = '\0'; break; case 'I': -#ifdef TAINT - if (euid != uid || egid != gid) - fatal("No -I allowed in setuid scripts"); -#endif + taint_not("-I"); if (*++s) { (void)av_push(GvAVn(incgv),newSVpv(s,0)); } else - fatal("No space allowed after -I"); + croak("No space allowed after -I"); break; case 'l': minus_l = TRUE; @@ -696,13 +676,14 @@ char *s; s++; return s; case 's': -#ifdef TAINT - if (euid != uid || egid != gid) - fatal("No -s allowed in setuid scripts"); -#endif + taint_not("-s"); doswitches = TRUE; s++; return s; + case 'T': + tainting = TRUE; + s++; + return s; case 'u': do_undump = TRUE; s++; @@ -712,9 +693,9 @@ char *s; s++; return s; case 'v': - fputs("\nThis is perl, version 5.0, Alpha 2 (unsupported)\n\n",stdout); + fputs("\nThis is perl, version 5.0, Alpha 4 (unsupported)\n\n",stdout); fputs(rcsid,stdout); - fputs("\nCopyright (c) 1989, 1990, 1991, 1992, 1993 Larry Wall\n",stdout); + fputs("\nCopyright (c) 1989, 1990, 1991, 1992, 1993, 1994 Larry Wall\n",stdout); #ifdef MSDOS fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n", stdout); @@ -746,7 +727,7 @@ GNU General Public License, which may be found in the Perl 5.0 source kit.\n",st case '\t': break; default: - fatal("Switch meaningless after -x: -%s",s); + croak("Switch meaningless after -x: -%s",s); } return Nullch; } @@ -777,9 +758,11 @@ my_unexec() static void init_main_stash() { - curstash = defstash = newHV(0); + GV *gv; + curstash = defstash = newHV(); curstname = newSVpv("main",4); - GvHV(gv_fetchpv("_main",TRUE)) = defstash; + GvHV(gv = gv_fetchpv("_main",TRUE)) = defstash; + SvREADONLY_on(gv); HvNAME(defstash) = "main"; incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE))); SvMULTI_on(incgv); @@ -837,7 +820,7 @@ SV *sv; xfailed = savestr(tokenbuf); } if (!xfound) - fatal("Can't execute %s", xfailed ? xfailed : scriptname ); + croak("Can't execute %s", xfailed ? xfailed : scriptname ); if (xfailed) Safefree(xfailed); scriptname = xfound; @@ -892,7 +875,7 @@ sed %s -e \"/^[^#]/b\" \ #endif (doextract ? "-e '1,/^#/d\n'" : ""), #endif - scriptname, tokenbuf, SvPVn(sv), CPPMINUS); + scriptname, tokenbuf, SvPV(sv, na), CPPMINUS); DEBUG_P(fprintf(stderr, "%s\n", buf)); doextract = FALSE; #ifdef IAMSUID /* actually, this is caught earlier */ @@ -907,16 +890,13 @@ sed %s -e \"/^[^#]/b\" \ #endif #endif if (geteuid() != uid) - fatal("Can't do seteuid!\n"); + croak("Can't do seteuid!\n"); } #endif /* IAMSUID */ rsfp = my_popen(buf,"r"); } else if (!*scriptname) { -#ifdef TAINT - if (euid != uid || egid != gid) - fatal("Can't take set-id script from stdin"); -#endif + taint_not("program input from stdin"); rsfp = stdin; } else @@ -924,16 +904,16 @@ sed %s -e \"/^[^#]/b\" \ if ((FILE*)rsfp == Nullfp) { #ifdef DOSUID #ifndef IAMSUID /* in case script is not readable before setuid */ - if (euid && stat(SvPV(GvSV(curcop->cop_filegv)),&statbuf) >= 0 && + if (euid && stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) { (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel); execv(buf, origargv); /* try again */ - fatal("Can't do setuid\n"); + croak("Can't do setuid\n"); } #endif #endif - fatal("Can't open perl script \"%s\": %s\n", - SvPV(GvSV(curcop->cop_filegv)), strerror(errno)); + croak("Can't open perl script \"%s\": %s\n", + SvPVX(GvSV(curcop->cop_filegv)), strerror(errno)); } } @@ -960,18 +940,11 @@ char *validarg; * DOSUID must be defined in both perl and suidperl, and IAMSUID must * be defined in suidperl only. suidperl must be setuid root. The * Configure script will set this up for you if you want it. - * - * There is also the possibility of have a script which is running - * set-id due to a C wrapper. We want to do the TAINT checks - * on these set-id scripts, but don't want to have the overhead of - * them in normal perl, and can't use suidperl because it will lose - * the effective uid info, so we have an additional non-setuid root - * version called taintperl or tperlN.NNN that just does the TAINT checks. */ #ifdef DOSUID if (fstat(fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */ - fatal("Can't stat script \"%s\"",origfilename); + croak("Can't stat script \"%s\"",origfilename); if (statbuf.st_mode & (S_ISUID|S_ISGID)) { I32 len; @@ -985,8 +958,8 @@ char *validarg; * But I don't think it's too important. The manual lies when * it says access() is useful in setuid programs. */ - if (access(SvPV(GvSV(curcop->cop_filegv)),1)) /*double check*/ - fatal("Permission denied"); + if (access(SvPVX(GvSV(curcop->cop_filegv)),1)) /*double check*/ + croak("Permission denied"); #else /* If we can swap euid and uid, then we can determine access rights * with a simple stat of the file, and then compare device and @@ -997,9 +970,9 @@ char *validarg; struct stat tmpstatbuf; if (setreuid(euid,uid) < 0 || getuid() != euid || geteuid() != uid) - fatal("Can't swap uid and euid"); /* really paranoid */ - if (stat(SvPV(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0) - fatal("Permission denied"); /* testing full pathname here */ + croak("Can't swap uid and euid"); /* really paranoid */ + if (stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0) + croak("Permission denied"); /* testing full pathname here */ if (tmpstatbuf.st_dev != statbuf.st_dev || tmpstatbuf.st_ino != statbuf.st_ino) { (void)fclose(rsfp); @@ -1009,34 +982,34 @@ char *validarg; (Filename of set-id script was %s, uid %d gid %d.)\n\nSincerely,\nperl\n", uid,tmpstatbuf.st_dev, tmpstatbuf.st_ino, statbuf.st_dev, statbuf.st_ino, - SvPV(GvSV(curcop->cop_filegv)), + SvPVX(GvSV(curcop->cop_filegv)), statbuf.st_uid, statbuf.st_gid); (void)my_pclose(rsfp); } - fatal("Permission denied\n"); + croak("Permission denied\n"); } if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid) - fatal("Can't reswap uid and euid"); + croak("Can't reswap uid and euid"); if (!cando(S_IXUSR,FALSE,&statbuf)) /* can real uid exec? */ - fatal("Permission denied\n"); + croak("Permission denied\n"); } #endif /* HAS_SETREUID */ #endif /* IAMSUID */ if (!S_ISREG(statbuf.st_mode)) - fatal("Permission denied"); + croak("Permission denied"); if (statbuf.st_mode & S_IWOTH) - fatal("Setuid/gid script is writable by world"); + croak("Setuid/gid script is writable by world"); doswitches = FALSE; /* -s is insecure in suid */ curcop->cop_line++; if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch || strnNE(tokenbuf,"#!",2) ) /* required even on Sys V */ - fatal("No #! line"); + croak("No #! line"); s = tokenbuf+2; if (*s == ' ') s++; while (!isSPACE(*s)) s++; if (strnNE(s-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */ - fatal("Not a perl script"); + croak("Not a perl script"); while (*s == ' ' || *s == '\t') s++; /* * #! arg must be what we saw above. They can invoke it by @@ -1046,13 +1019,13 @@ char *validarg; len = strlen(validarg); if (strEQ(validarg," PHOOEY ") || strnNE(s,validarg,len) || !isSPACE(s[len])) - fatal("Args must match #! line"); + croak("Args must match #! line"); #ifndef IAMSUID if (euid != uid && (statbuf.st_mode & S_ISUID) && euid == statbuf.st_uid) if (!do_undump) - fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ + croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #endif /* IAMSUID */ @@ -1062,7 +1035,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); (void)sprintf(buf, "%s/sperl%s", BIN, patchlevel); execv(buf, origargv); /* try again */ #endif - fatal("Can't do setuid\n"); + croak("Can't do setuid\n"); } if (statbuf.st_mode & S_ISGID && statbuf.st_gid != egid) { @@ -1076,7 +1049,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #endif #endif if (getegid() != statbuf.st_gid) - fatal("Can't do setegid!\n"); + croak("Can't do setegid!\n"); } if (statbuf.st_mode & S_ISUID) { if (statbuf.st_uid != euid) @@ -1090,7 +1063,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #endif #endif if (geteuid() != statbuf.st_uid) - fatal("Can't do seteuid!\n"); + croak("Can't do seteuid!\n"); } else if (uid) { /* oops, mustn't run as root */ #ifdef HAS_SETEUID @@ -1103,33 +1076,23 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #endif #endif if (geteuid() != uid) - fatal("Can't do seteuid!\n"); + croak("Can't do seteuid!\n"); } uid = (int)getuid(); euid = (int)geteuid(); gid = (int)getgid(); egid = (int)getegid(); + tainting |= (euid != uid || egid != gid); if (!cando(S_IXUSR,TRUE,&statbuf)) - fatal("Permission denied\n"); /* they can't do this */ + croak("Permission denied\n"); /* they can't do this */ } #ifdef IAMSUID else if (preprocess) - fatal("-P not allowed for setuid/setgid script\n"); + croak("-P not allowed for setuid/setgid script\n"); else - fatal("Script is not setuid/setgid in suidperl\n"); -#else -#ifndef TAINT /* we aren't taintperl or suidperl */ - /* script has a wrapper--can't run suidperl or we lose euid */ - else if (euid != uid || egid != gid) { - (void)fclose(rsfp); - (void)sprintf(buf, "%s/tperl%s", BIN, patchlevel); - execv(buf, origargv); /* try again */ - fatal("Can't run setuid script with taint checks"); - } -#endif /* TAINT */ + croak("Script is not setuid/setgid in suidperl\n"); #endif /* IAMSUID */ #else /* !DOSUID */ -#ifndef TAINT /* we aren't taintperl or suidperl */ if (euid != uid || egid != gid) { /* (suidperl doesn't exist, in fact) */ #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW fstat(fileno(rsfp),&statbuf); /* may be either wrapped or real suid */ @@ -1138,30 +1101,25 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID) ) if (!do_undump) - fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ + croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */ /* not set-id, must be wrapped */ - (void)fclose(rsfp); - (void)sprintf(buf, "%s/tperl%s", BIN, patchlevel); - execv(buf, origargv); /* try again */ - fatal("Can't run setuid script with taint checks"); } -#endif /* TAINT */ #endif /* DOSUID */ } static void find_beginning() { -#if !defined(IAMSUID) && !defined(TAINT) register char *s; /* skip forward in input to the real script? */ + taint_not("-x"); while (doextract) { if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) - fatal("No Perl script found in input\n"); + croak("No Perl script found in input\n"); if (*s == '#' && s[1] == '!' && instr(s,"perl")) { ungetc('\n',rsfp); /* to keep line count right */ doextract = FALSE; @@ -1171,10 +1129,9 @@ find_beginning() while (s = moreswitches(s)) ; } if (cddir && chdir(cddir) < 0) - fatal("Can't chdir to %s",cddir); + croak("Can't chdir to %s",cddir); } } -#endif /* !defined(IAMSUID) && !defined(TAINT) */ } static void @@ -1182,7 +1139,7 @@ init_debugger() { GV* tmpgv; - debstash = newHV(0); + debstash = newHV(); GvHV(gv_fetchpv("_DB",TRUE)) = debstash; curstash = debstash; dbargs = GvAV(gv_AVadd((tmpgv = gv_fetchpv("args",TRUE)))); @@ -1235,8 +1192,9 @@ init_stack() static void init_lexer() { - bufend = bufptr = SvPVn(linestr); + bufend = bufptr = SvPV(linestr, na); subname = newSVpv("main",4); + lex_start(); /* we never leave */ } static void @@ -1323,18 +1281,16 @@ register char **env; sv_setpvn(bodytarget, "", 0); formtarget = bodytarget; -#ifdef TAINT tainted = 1; -#endif - if (tmpgv = gv_fetchpv("0",allgvs)) { + if (tmpgv = gv_fetchpv("0",TRUE)) { sv_setpv(GvSV(tmpgv),origfilename); magicname("0", "0", 1); } - if (tmpgv = gv_fetchpv("\024",allgvs)) + if (tmpgv = gv_fetchpv("\024",TRUE)) time(&basetime); - if (tmpgv = gv_fetchpv("\030",allgvs)) + if (tmpgv = gv_fetchpv("\030",TRUE)) sv_setpv(GvSV(tmpgv),origargv[0]); - if (argvgv = gv_fetchpv("ARGV",allgvs)) { + if (argvgv = gv_fetchpv("ARGV",TRUE)) { SvMULTI_on(argvgv); (void)gv_AVadd(argvgv); av_clear(GvAVn(argvgv)); @@ -1342,14 +1298,11 @@ register char **env; (void)av_push(GvAVn(argvgv),newSVpv(argv[0],0)); } } -#ifdef TAINT - (void) gv_fetchpv("ENV",TRUE); /* must test PATH and IFS */ -#endif - if (envgv = gv_fetchpv("ENV",allgvs)) { + if (envgv = gv_fetchpv("ENV",TRUE)) { HV *hv; SvMULTI_on(envgv); hv = GvHVn(envgv); - hv_clear(hv, FALSE); + hv_clear(hv); hv_magic(hv, envgv, 'E'); if (env != environ) environ[0] = Nullch; @@ -1362,24 +1315,19 @@ register char **env; *s = '='; } } -#ifdef TAINT tainted = 0; -#endif - if (tmpgv = gv_fetchpv("$",allgvs)) + if (tmpgv = gv_fetchpv("$",TRUE)) sv_setiv(GvSV(tmpgv),(I32)getpid()); - if (dowarn) { - gv_check('A','Z'); - gv_check('a','z'); - } + if (dowarn) + gv_check(defstash); } static void init_perllib() { -#ifndef TAINT /* Can't allow arbitrary PERLLIB in setuid script */ - incpush(getenv("PERLLIB")); -#endif /* TAINT */ + if (!tainting) + incpush(getenv("PERLLIB")); #ifndef PRIVLIB #define PRIVLIB "/usr/local/lib/perl" @@ -1412,7 +1360,7 @@ AV* list; exit(1); } else { - perl_callback(SvPV(tmpsv), sp, G_SCALAR, 0, 0); + perl_callback(SvPVX(tmpsv), sp, G_SCALAR, 0, 0); } } sv_free(tmpsv); @@ -79,7 +79,6 @@ #endif /* work around some libPW problems */ -#define fatal Myfatal #ifdef DOINIT char Error[1]; #endif @@ -109,22 +108,10 @@ char Error[1]; # define VOL #endif -#ifdef IAMSUID -# ifndef TAINT -# define TAINT -# endif -#endif -#ifdef TAINT -# define TAINT_IF(c) (tainted |= (c)) -# define TAINT_NOT (tainted = 0) -# define TAINT_PROPER(s) taint_proper(no_security, s) -# define TAINT_ENV() taint_env() -#else -# define TAINT_IF(c) -# define TAINT_NOT -# define TAINT_PROPER(s) -# define TAINT_ENV() -#endif +#define TAINT_IF(c) (tainted |= (c)) +#define TAINT_NOT (tainted = 0) +#define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) +#define TAINT_ENV() if (tainting) taint_env() #ifndef HAS_VFORK # define vfork fork @@ -317,62 +304,6 @@ char Error[1]; # endif #endif -#ifdef WANT_DBZ -# include <dbz.h> -# define SOME_DBM -# define dbm_fetch(db,dkey) fetch(dkey) -# define dbm_delete(db,dkey) fatal("dbz doesn't implement delete") -# define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent) -# define dbm_close(db) dbmclose() -# define dbm_firstkey(db) (fatal("dbz doesn't implement traversal"),fetch()) -# define nextkey() (fatal("dbz doesn't implement traversal"),fetch()) -# define dbm_nextkey(db) (fatal("dbz doesn't implement traversal"),fetch()) -# ifdef HAS_NDBM -# undef HAS_NDBM -# endif -# ifndef HAS_ODBM -# define HAS_ODBM -# endif -#else -# ifdef HAS_GDBM -# ifdef I_GDBM -# include <gdbm.h> -# endif -# define SOME_DBM -# ifdef HAS_NDBM -# undef HAS_NDBM -# endif -# ifdef HAS_ODBM -# undef HAS_ODBM -# endif -# else -# ifdef HAS_NDBM -# include <ndbm.h> -# define SOME_DBM -# ifdef HAS_ODBM -# undef HAS_ODBM -# endif -# else -# ifdef HAS_ODBM -# ifdef NULL -# undef NULL /* suppress redefinition message */ -# endif -# include <dbm.h> -# ifdef NULL -# undef NULL -# endif -# define NULL 0 /* silly thing is, we don't even use this... */ -# define SOME_DBM -# define dbm_fetch(db,dkey) fetch(dkey) -# define dbm_delete(db,dkey) delete(dkey) -# define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent) -# define dbm_close(db) dbmclose() -# define dbm_firstkey(db) firstkey() -# endif /* HAS_ODBM */ -# endif /* HAS_NDBM */ -# endif /* HAS_GDBM */ -#endif /* WANT_DBZ */ - #if INTSIZE == 2 # define htoni htons # define ntohi ntohs @@ -765,7 +696,7 @@ GIDTYPE getegid P(()); #define assert(what) DEB( { \ if (!(what)) { \ - fatal("Assertion failed: file \"%s\", line %d", \ + croak("Assertion failed: file \"%s\", line %d", \ __FILE__, __LINE__); \ exit(1); \ }}) @@ -857,8 +788,9 @@ EXT int gid; /* current real group id */ EXT int egid; /* current effective group id */ EXT bool nomemok; /* let malloc context handle nomem */ EXT U32 an; /* malloc sequence number */ -EXT U32 cop_seq; /* statement sequence number */ -EXT U32 op_seq; /* op sequence number */ +EXT U32 cop_seqmax; /* statement sequence number */ +EXT U32 op_seqmax; /* op sequence number */ +EXT U32 sub_generation; /* inc to force methods to be looked up again */ EXT char ** origenviron; EXT U32 origalen; @@ -898,6 +830,7 @@ EXT struct stat statbuf; #ifndef MSDOS EXT struct tms timesbuf; #endif +EXT STRLEN na; /* for use in SvPV when length is Not Applicable */ /* for tmp use in stupid debuggers */ EXT int * di; @@ -911,7 +844,11 @@ EXT char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx"); EXT char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"); EXT char * vert INIT("|"); -EXT char * warn_nl +EXT char warn_nosemi[] + INIT("Semicolon seems to be missing"); +EXT char warn_reserved[] + INIT("Unquoted string \"%s\" may clash with future reserved word"); +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"); @@ -924,7 +861,7 @@ EXT char no_modify[] EXT char no_mem[] INIT("Out of memory!\n"); EXT char no_security[] - INIT("Insecure dependency in %s"); + INIT("Insecure dependency in %s%s"); EXT char no_sock_func[] INIT("Unsupported socket function \"%s\" called"); EXT char no_dir_func[] @@ -949,20 +886,6 @@ EXT char *sig_name[]; #endif #ifdef DOINIT - EXT char coeff[] = { /* hash function coefficients */ - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1}; -#else - EXT char coeff[]; -#endif - -#ifdef DOINIT EXT unsigned char fold[] = { /* fast case folding table */ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, @@ -1081,6 +1004,7 @@ EXT char * last_uni; /* position of last named-unary operator */ EXT char * last_lop; /* position of 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? */ #ifdef FCRYPT EXT I32 cryptseen; /* has fast crypt() been initialized? */ #endif @@ -1147,7 +1071,6 @@ IEXT bool Iminus_a; IEXT bool Idoswitches; IEXT bool Idowarn; IEXT bool Idoextract; -IEXT bool Iallgvs; /* init all customary symbols in symbol table?*/ IEXT bool Isawampersand; /* must save all match strings */ IEXT bool Isawstudy; /* do fbm_instr on all strings */ IEXT bool Isawi; /* study must assume case insensitive */ @@ -1238,15 +1161,13 @@ IEXT AV * Ifdpid; /* keep fd-to-pid mappings for my_popen */ IEXT HV * Ipidstatus; /* keep pid-to-status mappings for waitpid */ /* internal state */ -IEXT VOL int Iin_eval; /* trap fatal errors? */ -IEXT OP * Irestartop; /* Are we propagating an error from fatal? */ +IEXT VOL int Iin_eval; /* trap "fatal" errors? */ +IEXT OP * Irestartop; /* Are we propagating an error from croak? */ IEXT int Idelaymagic; /* ($<,$>) = ... */ IEXT bool Idirty; /* clean before rerunning */ IEXT bool Ilocalizing; /* are we processing a local() list? */ -#ifdef TAINT IEXT bool Itainted; /* using variables controlled by $< */ -IEXT bool Itaintanyway; /* force taint checks when !set?id */ -#endif +IEXT bool Itainting; /* doing taint checks */ /* trace state */ IEXT I32 Idlevel; @@ -1255,10 +1176,10 @@ IEXT char * Idebname; IEXT char * Idebdelim; /* current interpreter roots */ -IEXT OP * VOL Imain_root; -IEXT OP * VOL Imain_start; -IEXT OP * VOL Ieval_root; -IEXT OP * VOL Ieval_start; +IEXT OP * Imain_root; +IEXT OP * Imain_start; +IEXT OP * Ieval_root; +IEXT OP * Ieval_start; /* runtime control stuff */ IEXT COP * VOL Icurcop IINIT(&compiling); @@ -1276,9 +1197,9 @@ IEXT SV ** Imystack_sp; /* stack pointer now */ IEXT SV ** Imystack_max; /* stack->array_ary + stack->array_max */ /* format accumulators */ -IEXT SV * formtarget; -IEXT SV * bodytarget; -IEXT SV * toptarget; +IEXT SV * Iformtarget; +IEXT SV * Ibodytarget; +IEXT SV * Itoptarget; /* statics moved here for shared library purposes */ IEXT SV Istrchop; /* return value from chop */ @@ -1295,7 +1216,6 @@ IEXT AV * Isortstack; /* temp stack during pp_sort() */ IEXT AV * Isignalstack; /* temp stack during sighandler() */ IEXT SV * Imystrk; /* temp key string for do_each() */ IEXT I32 Idumplvl; /* indentation level on syntax tree dump */ -IEXT I32 Idbmrefcnt; /* safety check for old dbm */ IEXT PMOP * Ioldlastpm; /* for saving regexp context during debugger */ IEXT I32 Igensym; /* next symbol for getsym() to define */ IEXT bool Ipreambled; @@ -1328,33 +1248,62 @@ extern "C" { /* The following must follow proto.h */ #ifdef DOINIT -MGVTBL vtbl_sv = {magic_get, magic_set, magic_len, 0, 0}; -MGVTBL vtbl_env = {0, 0, 0, 0, 0}; -MGVTBL vtbl_envelem = {0, magic_setenv, 0, 0, 0}; -MGVTBL vtbl_sig = {0, 0, 0, 0, 0}; -MGVTBL vtbl_sigelem = {0, magic_setsig, 0, 0, 0}; -MGVTBL vtbl_dbm = {0, 0, 0, 0, 0}; -MGVTBL vtbl_dbmelem = {0, magic_setdbm, 0, 0, 0}; -MGVTBL vtbl_dbline = {0, magic_setdbline, 0, 0, 0}; -MGVTBL vtbl_arylen = {magic_getarylen,magic_setarylen, 0, 0, 0}; -MGVTBL vtbl_glob = {magic_getglob, magic_setglob, 0, 0, 0}; -MGVTBL vtbl_mglob = {0, magic_setmglob, 0, 0, 0}; -MGVTBL vtbl_substr = {0, magic_setsubstr, 0, 0, 0}; -MGVTBL vtbl_vec = {0, magic_setvec, 0, 0, 0}; -MGVTBL vtbl_bm = {0, magic_setbm, 0, 0, 0}; -MGVTBL vtbl_uvar = {magic_getuvar, magic_setuvar, 0, 0, 0}; +MGVTBL vtbl_sv = {magic_get, + magic_set, + magic_len, + 0, 0}; +MGVTBL vtbl_env = {0, 0, 0, 0, 0}; +MGVTBL vtbl_envelem = {0, magic_setenv, + 0, 0, 0}; +MGVTBL vtbl_sig = {0, 0, 0, 0, 0}; +MGVTBL vtbl_sigelem = {0, magic_setsig, + 0, 0, 0}; +MGVTBL vtbl_pack = {0, 0, + 0, 0, 0}; +MGVTBL vtbl_packelem = {magic_getpack, + magic_setpack, + 0, magic_clearpack, + 0}; +MGVTBL vtbl_dbline = {0, magic_setdbline, + 0, 0, 0}; +MGVTBL vtbl_isa = {0, magic_setisa, + 0, 0, 0}; +MGVTBL vtbl_isaelem = {0, magic_setisa, + 0, 0, 0}; +MGVTBL vtbl_arylen = {magic_getarylen, + magic_setarylen, + 0, 0, 0}; +MGVTBL vtbl_glob = {magic_getglob, + magic_setglob, + 0, 0, 0}; +MGVTBL vtbl_mglob = {0, magic_setmglob, + 0, 0, 0}; +MGVTBL vtbl_taint = {magic_gettaint,magic_settaint, + 0, 0, 0}; +MGVTBL vtbl_substr = {0, magic_setsubstr, + 0, 0, 0}; +MGVTBL vtbl_vec = {0, magic_setvec, + 0, 0, 0}; +MGVTBL vtbl_bm = {0, magic_setbm, + 0, 0, 0}; +MGVTBL vtbl_uvar = {magic_getuvar, + magic_setuvar, + 0, 0, 0}; #else EXT MGVTBL vtbl_sv; EXT MGVTBL vtbl_env; EXT MGVTBL vtbl_envelem; EXT MGVTBL vtbl_sig; EXT MGVTBL vtbl_sigelem; -EXT MGVTBL vtbl_dbm; -EXT MGVTBL vtbl_dbmelem; +EXT MGVTBL vtbl_pack; +EXT MGVTBL vtbl_packelem; EXT MGVTBL vtbl_dbline; +EXT MGVTBL vtbl_isa; +EXT MGVTBL vtbl_isaelem; EXT MGVTBL vtbl_arylen; EXT MGVTBL vtbl_glob; EXT MGVTBL vtbl_mglob; +EXT MGVTBL vtbl_taint; EXT MGVTBL vtbl_substr; EXT MGVTBL vtbl_vec; EXT MGVTBL vtbl_bm; @@ -157,7 +157,9 @@ script you must explicitly specify a \- for the script name. After locating your script, .I perl compiles it to an internal form. -If the script is syntactically correct, it is executed. +If the script is syntactically correct, it is executed. If the script +runs off the end without hitting an exit or die operator, an implicit +exit(0) is provided to indicate successful completion. .Sh "Options" Note: on first reading this section may not make much sense to you. It's here at the front for easy reference. @@ -1650,6 +1652,23 @@ Thus, a portable way to find out the home directory might be: (getpwuid($<))[7] || die "You're homeless!\en"; .fi +As more readable alternatives to && and ||, Perl provides "and" and "or" +operators. The short-circuit behavior is identical. The precedence of +"and" and "or" is much lower, however, so that you can safely use them +after a list operator without the need for parentheses: +.nf + + unlink "alpha", "beta", "gamma" + or gripe(), next LINE; + +.fi +With the old-style operators that would have been written like this: +.nf + + unlink("alpha", "beta", "gamma") + || (gripe(), next LINE); + +.fi .PP Along with the literals and variables mentioned earlier, the operations in the following section can serve as terms in an expression. @@ -1698,9 +1717,11 @@ operator. This is a useful optimization when you only want to see the first occurrence of something in each file of a set of files, for instance. Only ?? patterns local to the current package are reset. +.Ip "abs(VALUE)" 8 4 +Returns the absolute value of its argument. .Ip "accept(NEWSOCKET,GENERICSOCKET)" 8 2 Does the same thing that the accept system call does. -Returns true if it succeeded, false otherwise. +Returns the packed address if it succeeded, false otherwise. See example in section on Interprocess Communication. .Ip "alarm(SECONDS)" 8 4 .Ip "alarm SECONDS" 8 @@ -1832,6 +1853,9 @@ Here's an example that looks up non-numeric uids in the passwd file: } .fi +.Ip "chr(NUMBER)" 8 5 +Returns the character represented by that NUMBER in the character set. +For example, chr(65) is "A". .Ip "chroot(FILENAME)" 8 5 .Ip "chroot FILENAME" 8 Does the same as the system call of that name. @@ -1881,11 +1905,15 @@ Useful for checking the password file for lousy passwords. Only the guys wearing white hats should do this. .Ip "dbmclose(ASSOC_ARRAY)" 8 6 .Ip "dbmclose ASSOC_ARRAY" 8 +[This function has be superseded by the untie() function.] +.Sp Breaks the binding between a dbm file and an associative array. The values remaining in the associative array are meaningless unless you happen to want to know what was in the cache for the dbm file. This function is only useful if you have ndbm. .Ip "dbmopen(ASSOC,DBNAME,MODE)" 8 6 +[This function has be superseded by the tie() function.] +.Sp This binds a dbm or ndbm file to an associative array. ASSOC is the name of the associative array. (Unlike normal open, the first argument is NOT a filehandle, even though @@ -1917,11 +1945,11 @@ Example: .ne 6 # print out history file offsets - dbmopen(HIST,'/usr/lib/news/history',0666); + dbmopen(%HIST,'/usr/lib/news/history',0666); while (($key,$val) = each %HIST) { print $key, ' = ', unpack('L',$val), "\en"; } - dbmclose(HIST); + dbmclose(%HIST); .fi .Ip "defined(EXPR)" 8 6 @@ -3129,7 +3157,8 @@ of values, as follows: N A long in \*(L"network\*(R" order. f A single-precision float in the native format. d A double-precision float in the native format. - p A pointer to a string. + p A pointer to a null-terminated string. + P A pointer to a structure. v A short in \*(L"VAX\*(R" (little-endian) order. V A long in \*(L"VAX\*(R" (little-endian) order. x A null byte. @@ -3144,7 +3173,7 @@ of values, as follows: .fi Each letter may optionally be followed by a number which gives a repeat count. -With all types except "a", "A", "b", "B", "h" and "H", +With all types except "a", "A", "b", "B", "h" and "H", and "P" the pack function will gobble up that many values from the LIST. A * for the repeat count means to use however many items are left. @@ -3154,6 +3183,7 @@ padding with nulls or spaces as necessary. (When unpacking, "A" strips trailing spaces and nulls, but "a" does not.) Likewise, the "b" and "B" fields pack a string that many bits long. The "h" and "H" fields pack a string that many nybbles long. +The "P" packs a pointer to a structure of the size indicated by the length. Real numbers (floats and doubles) are in the native machine format only; due to the multiplicity of floating formats around, and the lack of a standard \*(L"network\*(R" representation, no facility for @@ -3421,12 +3451,9 @@ The use of reset on dbm associative arrays does not change the dbm file. you are sharing the dbm file. Then again, maybe not.) .Ip "return LIST" 8 3 -Returns from a subroutine with the value specified. -(Note that a subroutine can automatically return -the value of the last expression evaluated. -That's the preferred method\*(--use of an explicit -.I return -is a bit slower.) +Returns from a subroutine or eval with the value specified. +(Note that in the absence of a return a subroutine will automatically return +the value of the last expression evaluated.) .Ip "reverse(LIST)" 8 4 .Ip "reverse LIST" 8 In an array context, returns an array value consisting of the elements @@ -4062,6 +4089,64 @@ Value may be given to seekdir() to access a particular location in a directory. Has the same caveats about possible directory compaction as the corresponding system library routine. +.Ip "tie VARIABLE,PACKAGENAME,LIST" 8 6 +This function binds a variable to a package that will provide the +implementation for the variable. +VARIABLE is the name of the variable to be enchanted. +PACKAGENAME is the name of a package implementing objects of correct type. +Any additional arguments are passed to the "new" method of the package. +Typically these are arguments such as might be passed to the dbm_open() +function of C. +.Sp +Note that functions such as keys() and values() may return huge array values +when used on large dbm files. +You may prefer to use the each() function to iterate over large dbm files. +Example: +.nf + +.ne 6 + # print out history file offsets + tie(%HIST, NDBM_File, '/usr/lib/news/history', 1, 0); + while (($key,$val) = each %HIST) { + print $key, ' = ', unpack('L',$val), "\en"; + } + untie(%HIST); + +.fi +A package implementing an associative array should have the following methods: +.nf + +.ne 7 + new objectname, LIST + DESTROY this + fetch this, key + store this, key, value + delete this, key + firstkey this + nextkey this, lastkey + +.fi +A package implementing an ordinary array should have the following methods: +.nf + +.ne 7 + new objectname, LIST + DESTROY this + fetch this, key + store this, key, value + [others TBD] + +.fi +A package implementing a scalar should have the following methods: +.nf + +.ne 4 + new objectname, LIST + DESTROY this + fetch this, + store this, value + +.fi .Ip "time" 8 4 Returns the number of non-leap seconds since 00:00:00 UTC, January 1, 1970. Suitable for feeding to gmtime() and localtime(). @@ -4216,6 +4301,8 @@ The following efficiently counts the number of set bits in a bit vector: $setbits = unpack("%32b*", $selectmask); .fi +.Ip "untie VARIABLE" 8 6 +Breaks the binding between a variable and a package. (See tie.) .Ip "unshift(ARRAY,LIST)" 8 4 Does the opposite of a .IR shift . @@ -4918,6 +5005,7 @@ out. You'll just have to suffer along with these silly symbols. Most of them have reasonable mnemonics, or analogues in one of the shells. .Ip $_ 8 +''' UNDER The default input and pattern-searching space. The following pairs are equivalent: .nf @@ -4941,6 +5029,7 @@ The following pairs are equivalent: .fi (Mnemonic: underline is understood in certain operations.) .Ip $. 8 +''' INPUT_LINE The current input line number of the last filehandle that was read. Readonly. Remember that only an explicit close on the filehandle resets the line number. @@ -4948,6 +5037,7 @@ Since <> never does an explicit close, line numbers increase across ARGV files (but see examples under eof). (Mnemonic: many programs use . to mean the current line number.) .Ip $/ 8 +''' RS or INPUT_RECORD_SEPARATOR The input record separator, newline by default. Works like .IR awk 's @@ -4963,6 +5053,7 @@ Setting it to "\en\en" will blindly assume that the next input character belongs to the next paragraph, even if it's a newline. (Mnemonic: / is used to delimit line boundaries when quoting poetry.) .Ip $, 8 +''' OFS or OUTPUT_FIELD_SEPARATOR The output field separator for the print operator. Ordinarily the print operator simply prints out the comma separated fields you specify. @@ -4973,11 +5064,13 @@ set this variable as you would set OFS variable to specify what is printed between fields. (Mnemonic: what is printed when there is a , in your print statement.) .Ip $"" 8 +''' LIST_SEPARATOR This is like $, except that it applies to array values interpolated into a double-quoted string (or similar interpreted string). Default is a space. (Mnemonic: obvious, I think.) .Ip $\e 8 +''' ORS or OUTPUT_RECORD_SEPARATOR The output record separator for the print operator. Ordinarily the print operator simply prints out the comma separated fields you specify, with no trailing newline or record separator assumed. @@ -4990,6 +5083,7 @@ ORS variable to specify what is printed at the end of the print. Also, it's just like /, but it's what you get \*(L"back\*(R" from .IR perl .) .Ip $# 8 +''' OFMT or OUTPUT_FORMAT The output format for printed numbers. This variable is a half-hearted attempt to emulate .IR awk 's @@ -5006,27 +5100,33 @@ explicitly to get value. (Mnemonic: # is the number sign.) .Ip $% 8 +''' PAGE The current page number of the currently selected output channel. (Mnemonic: % is page number in nroff.) .Ip $= 8 +''' PRINTABLE_LINES The current page length (printable lines) of the currently selected output channel. Default is 60. (Mnemonic: = has horizontal lines.) .Ip $\- 8 +''' LINES_REMAINING The number of lines left on the page of the currently selected output channel. (Mnemonic: lines_on_page \- lines_printed.) .Ip $~ 8 +''' FORMAT_NAME The name of the current report format for the currently selected output channel. Default is name of the filehandle. (Mnemonic: brother to $^.) .Ip $^ 8 +''' TOP_FORMAT_NAME The name of the current top-of-page format for the currently selected output channel. Default is name of the filehandle with \*(L"_TOP\*(R" appended. (Mnemonic: points to top of page.) .Ip $| 8 +''' AUTOFLUSH If set to nonzero, forces a flush after every write or print on the currently selected output channel. Default is 0. @@ -5041,11 +5141,13 @@ script under rsh and want to see the output as it's happening. (Mnemonic: when you want your pipes to be piping hot.) .Ip $$ 8 +''' PID The process number of the .I perl running this script. (Mnemonic: same as shells.) .Ip $? 8 +''' STATUS The status returned by the last pipe close, backtick (\`\`) command or .I system operator. @@ -5055,16 +5157,19 @@ $? & 255 gives which signal, if any, the process died from, and whether there was a core dump. (Mnemonic: similar to sh and ksh.) .Ip $& 8 4 +''' MATCH The string matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval enclosed by the current BLOCK). (Mnemonic: like & in some editors.) .Ip $\` 8 4 +''' LEFT The string preceding whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval enclosed by the current BLOCK). (Mnemonic: \` often precedes a quoted string.) .Ip $\' 8 4 +''' RIGHT The string following whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval enclosed by the current BLOCK). @@ -5079,6 +5184,7 @@ Example: .fi .Ip $+ 8 4 +''' LAST_PAREN_MATCH The last bracket matched by the last search pattern. This is useful if you don't know which of a set of alternative patterns matched. @@ -5090,6 +5196,7 @@ For example: .fi (Mnemonic: be positive and forward looking.) .Ip $* 8 2 +''' MULTILINE_MATCHING Set to 1 to do multiline matching within a string, 0 to tell .I perl that it can assume that strings contain a single line, for the purpose @@ -5101,6 +5208,7 @@ Default is 0. Note that this variable only influences the interpretation of ^ and $. A literal newline can be searched for even when $* == 0. .Ip $0 8 +''' PROGRAM_NAME Contains the name of the file containing the .I perl script being executed. @@ -5112,6 +5220,7 @@ pattern matched, not counting patterns matched in nested blocks that have been exited already. (Mnemonic: like \edigit.) .Ip $[ 8 2 +''' ARRAY_BASE The index of the first element in an array, and of the first character in a substring. Default is 0, but you could set it to 1 to make @@ -5122,6 +5231,7 @@ behave more like when subscripting and when evaluating the index() and substr() functions. (Mnemonic: [ begins subscripts.) .Ip $] 8 2 +''' PERL_VERSION The string printed out when you say \*(L"perl -v\*(R". It can be used to determine at the beginning of a script whether the perl interpreter executing the script is in the right range of versions. @@ -5143,6 +5253,7 @@ or, used numerically, .fi (Mnemonic: Is this version of perl in the right bracket?) .Ip $; 8 2 +''' SUBSEP or SUBSCRIPT_SEPARATOR The subscript separator for multi-dimensional array emulation. If you refer to an associative array element as .nf @@ -5169,6 +5280,7 @@ value for $;. Yeah, I know, it's pretty lame, but $, is already taken for something more important.) .Ip $! 8 2 +''' ERRNO If used in a numeric context, yields the current value of errno, with all the usual caveats. (This means that you shouldn't depend on the value of $! to be anything @@ -5180,14 +5292,17 @@ if, for instance, you want $! to return the string for error n, or you want to set the exit value for the die operator. (Mnemonic: What just went bang?) .Ip $@ 8 2 +''' EVAL_ERROR The perl syntax error message from the last eval command. If null, the last eval parsed and executed correctly (although the operations you invoked may have failed in the normal fashion). (Mnemonic: Where was the syntax error \*(L"at\*(R"?) .Ip $< 8 2 +''' UID or REAL_USER_ID The real uid of this process. (Mnemonic: it's the uid you came FROM, if you're running setuid.) .Ip $> 8 2 +''' EUID or EFFECTIVE_USER_ID The effective uid of this process. Example: .nf @@ -5200,6 +5315,7 @@ Example: (Mnemonic: it's the uid you went TO, if you're running setuid.) Note: $< and $> can only be swapped on machines supporting setreuid(). .Ip $( 8 2 +''' GID or REAL_GROUP_ID The real gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. @@ -5208,6 +5324,7 @@ by getgroups(), one of which may be the same as the first number. (Mnemonic: parentheses are used to GROUP things. The real gid is the group you LEFT, if you're running setgid.) .Ip $) 8 2 +''' EGID or EFFECTIVE_GROUP_ID The effective gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. @@ -5220,33 +5337,40 @@ Note: $<, $>, $( and $) can only be set on machines that support the corresponding set[re][ug]id() routine. $( and $) can only be swapped on machines supporting setregid(). .Ip $: 8 2 +''' LINE_BREAK_CHARACTERS The current set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format. Default is "\ \en-", to break on whitespace or hyphens. (Mnemonic: a \*(L"colon\*(R" in poetry is a part of a line.) .Ip $^D 8 2 +''' DEBUGGING The current value of the debugging flags. (Mnemonic: value of .B \-D switch.) .Ip $^F 8 2 +''' SYSTEM_FD_MAX The maximum system file descriptor, ordinarily 2. System file descriptors are passed to subprocesses, while higher file descriptors are not. During an open, system file descriptors are preserved even if the open fails. Ordinary file descriptors are closed before the open is attempted. .Ip $^I 8 2 +''' INPLACE_EDIT The current value of the inplace-edit extension. Use undef to disable inplace editing. (Mnemonic: value of .B \-i switch.) .Ip $^L 8 2 +''' FORMFEED What formats output to perform a formfeed. Default is \ef. .Ip $^P 8 2 +''' PERLDB The internal flag that the debugger clears so that it doesn't debug itself. You could conceivable disable debugging yourself by clearing it. .Ip $^T 8 2 +''' BASETIME The time at which the script began running, in seconds since the epoch. The values returned by the .B \-M , @@ -5255,11 +5379,13 @@ and .B \-C filetests are based on this value. .Ip $^W 8 2 +''' WARNING The current value of the warning switch. (Mnemonic: related to the .B \-w switch.) .Ip $^X 8 2 +''' EXECUTABLE_NAME The name that Perl itself was executed as, from argv[0]. .Ip $ARGV 8 3 contains the name of the current file when reading from <>. @@ -50,22 +50,24 @@ typedef union { #define DELETE 286 #define HASHBRACK 287 #define NOAMP 288 -#define LSTOP 289 -#define OROR 290 -#define ANDAND 291 -#define BITOROP 292 -#define BITANDOP 293 -#define UNIOP 294 -#define SHIFTOP 295 -#define MATCHOP 296 -#define ARROW 297 -#define UMINUS 298 -#define REFGEN 299 -#define POWOP 300 -#define PREINC 301 -#define PREDEC 302 -#define POSTINC 303 -#define POSTDEC 304 +#define OROP 289 +#define ANDOP 290 +#define LSTOP 291 +#define OROR 292 +#define ANDAND 293 +#define BITOROP 294 +#define BITANDOP 295 +#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 YYERRCODE 256 short yylhs[] = { -1, 30, 0, 7, 3, 8, 8, 8, 9, 9, 9, @@ -76,14 +78,14 @@ short yylhs[] = { -1, 14, 27, 27, 27, 27, 27, 27, 27, 27, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, + 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, - 16, 16, 16, 16, 16, 16, 16, 24, 24, 22, - 17, 18, 19, 20, 21, 25, 25, 25, 25, 4, - 4, 5, 5, 6, 6, + 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, + 16, 16, 24, 24, 22, 17, 18, 19, 20, 21, + 25, 25, 25, 25, 4, 4, 5, 5, 6, 6, }; short yylen[] = { 2, 0, 2, 4, 0, 0, 2, 2, 2, 1, 2, @@ -93,1098 +95,1347 @@ short yylen[] = { 2, 1, 1, 1, 3, 2, 3, 3, 3, 2, 3, 1, 3, 5, 4, 6, 6, 3, 2, 4, 3, 4, 4, 4, 4, 4, 4, 4, 4, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, - 3, 1, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 3, 2, 3, 2, 3, 3, 1, 1, - 4, 5, 1, 1, 1, 5, 6, 6, 5, 4, - 5, 6, 8, 1, 1, 3, 4, 3, 2, 2, - 4, 5, 4, 5, 1, 2, 1, 2, 2, 1, - 3, 3, 4, 4, 6, 1, 1, 0, 1, 2, - 2, 2, 2, 2, 2, 1, 1, 1, 1, 2, - 1, 2, 1, 3, 2, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 5, 3, 1, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 3, 2, 3, 2, 3, 3, + 1, 1, 4, 5, 4, 1, 1, 1, 5, 6, + 5, 6, 5, 4, 5, 6, 8, 1, 1, 3, + 4, 3, 4, 2, 2, 4, 5, 4, 5, 1, + 2, 1, 2, 2, 1, 3, 3, 4, 4, 6, + 1, 1, 0, 1, 2, 2, 2, 2, 2, 2, + 1, 1, 1, 1, 2, 1, 2, 1, 3, 2, }; short yydefred[] = { 1, 0, 5, 0, 40, 0, 0, 0, 6, 41, 7, 9, 0, 42, 43, 4, 0, 45, 0, 0, 49, - 12, 0, 0, 114, 0, 149, 0, 0, 0, 0, + 12, 0, 0, 118, 0, 154, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, - 0, 0, 0, 0, 0, 103, 105, 100, 0, 0, - 0, 137, 5, 44, 47, 46, 48, 146, 148, 147, + 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, 126, 0, 0, 0, 144, 0, 120, 0, + 0, 0, 131, 0, 0, 0, 149, 0, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 58, 0, - 128, 0, 0, 0, 0, 90, 91, 0, 0, 0, - 0, 96, 0, 140, 141, 142, 143, 145, 0, 34, + 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, - 88, 89, 0, 0, 0, 0, 0, 11, 0, 0, - 57, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 36, 0, 131, 132, 0, 0, 0, - 0, 0, 0, 0, 98, 0, 0, 97, 118, 52, - 0, 151, 0, 0, 0, 153, 95, 26, 0, 0, + 0, 0, 0, 90, 91, 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, + 0, 99, 122, 0, 52, 0, 156, 0, 0, 0, + 158, 97, 26, 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, 116, 0, 0, 0, 3, 134, 0, 0, - 29, 0, 30, 0, 0, 0, 23, 0, 24, 0, - 0, 0, 133, 59, 0, 121, 0, 123, 0, 0, - 0, 0, 155, 0, 150, 0, 152, 0, 0, 0, + 0, 120, 0, 0, 0, 3, 139, 0, 0, 29, + 0, 30, 0, 0, 0, 23, 0, 24, 0, 0, + 0, 138, 59, 0, 126, 0, 128, 0, 0, 0, + 0, 160, 123, 0, 155, 0, 157, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 101, 0, 110, 117, 0, 54, 0, 0, 0, 0, - 19, 0, 0, 0, 0, 0, 53, 122, 124, 0, - 0, 154, 109, 0, 0, 0, 0, 102, 106, 111, - 0, 135, 27, 28, 21, 0, 22, 0, 32, 0, - 0, 112, 108, 107, 56, 55, 0, 0, 31, 0, - 0, 0, 113, 20, 33, + 105, 0, 103, 0, 114, 121, 0, 54, 0, 0, + 0, 0, 19, 0, 0, 0, 0, 0, 53, 127, + 129, 0, 0, 159, 113, 0, 0, 111, 0, 0, + 104, 109, 115, 0, 140, 27, 28, 21, 0, 22, + 0, 32, 0, 0, 116, 112, 110, 56, 55, 0, + 0, 31, 0, 0, 0, 117, 20, 33, }; short yydgoto[] = { 1, - 8, 9, 73, 194, 197, 188, 79, 3, 10, 11, - 60, 172, 247, 108, 62, 63, 64, 65, 66, 67, - 68, 69, 174, 109, 71, 164, 72, 12, 130, 2, + 8, 9, 73, 199, 202, 192, 79, 3, 10, 11, + 60, 176, 256, 108, 62, 63, 64, 65, 66, 67, + 68, 69, 178, 109, 71, 168, 72, 12, 130, 2, 13, 14, }; short yysindex[] = { 0, - 0, 0, 20, 0, -122, -241, -57, 0, 0, 0, - 0, 606, 0, 0, 0, -84, 0, -32, 39, 0, - 0, 0, -33, 0, 19, 0, -28, -23, -21, -19, - 169, -143, 77, 83, 107, -33, 2774, 2835, 172, 884, - -108, 2835, 2835, 2835, 2835, 2835, 2835, 2835, 945, 0, - 2835, 2835, 992, -33, -33, -33, -33, -33, -106, 0, - -14, 1210, -59, -60, -58, 0, 0, 0, 143, 159, - -76, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2835, 2835, 2835, -84, 2835, -84, 2835, -84, 2835, -84, - 1056, 194, 0, 201, 1262, 2835, 0, 209, 0, -1, - -30, -1, 223, 147, 139, 28, 2835, 231, 0, 1323, - 0, -1, -237, -237, -237, 0, 0, 182, 115, -237, - -237, 0, -18, 0, 0, 0, 0, 0, -84, 0, - 2835, 2835, 2835, 2835, 2835, 2835, 2835, 2835, 1370, 1434, - 2835, 2835, 1640, 1701, 1748, 1812, 2018, 2835, 2079, -87, - 0, 0, 2835, 2835, 2835, 2835, 2126, 0, -92, -119, - 0, 4249, 231, 245, -106, 141, -106, 217, -44, 246, - -44, 233, -36, 0, 2835, 0, 0, 257, 255, 1323, - 2190, 2396, 181, 2835, 0, 2457, 184, 0, 0, 0, - 2835, 0, 2504, 215, 2568, 0, 0, 0, 231, 231, - 231, 231, 1210, -89, -1, -174, 2835, -40, 2835, -236, - 1210, 409, 2835, 345, 2835, 376, 2835, -238, 2835, 382, - 2835, -247, 16, 2835, 16, 2835, 270, 2835, 68, -16, - 75, -15, 0, 115, 271, 2835, 0, 0, 2835, -84, - 0, -84, 0, -84, -84, 277, 0, -84, 0, 2835, - -84, 115, 0, 0, 278, 0, 115, 0, 115, 2835, - 96, 193, 0, -4, 0, 2835, 0, 1210, 1210, 2835, - 1210, 1210, 1210, 1210, 1210, 1210, 116, 2835, 3, 196, - 0, 199, 0, 0, 2835, 0, 4397, -106, -106, -44, - 0, 2835, -44, 266, -106, -84, 0, 0, 0, 136, - 203, 0, 0, 4, 1102, 218, 303, 0, 0, 0, - 304, 0, 0, 0, 0, 264, 0, 1056, 0, -106, - 228, 0, 0, 0, 0, 0, -84, 307, 0, 313, - -44, -84, 0, 0, 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, }; short yyrindex[] = { 0, - 0, 0, 229, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 463, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 496, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 2708, 2864, 0, 0, 0, 0, 0, 0, 0, - 0, 2904, 2978, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 73, 0, - 11, 363, 4373, 557, 3023, 0, 0, 0, 3161, 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, 0, 0, 0, 0, 0, 0, 0, 100, 0, + 46, 5017, 5512, 618, 3723, 0, 0, 0, 2930, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2904, 0, 322, 0, 0, 0, 0, 0, 0, 0, - 305, 0, 0, 0, 0, 324, 0, 3236, 0, 2284, - 3280, 3735, 0, 0, 0, 0, 2904, 3408, 0, 3449, - 0, 3768, 4128, 4182, 4218, 0, 0, 3319, 0, 4284, - 4320, 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, 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, 678, - 0, 0, 15, 0, 125, 0, 125, 0, 177, 0, - 177, 0, 309, 0, 0, 0, 0, 0, 0, 324, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 3362, 0, 0, 0, 0, 79, 98, - 128, 135, 860, 958, 3834, 3867, 0, 1906, 0, 1150, - 1575, 0, 0, 1021, 0, 4047, 0, 4005, 0, 3915, - 0, 1528, 3577, 0, 3702, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 2904, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 310, + 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, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 1953, 2331, 0, - 2667, 3620, 3907, 3931, 4037, 4063, 0, 324, 0, 0, - 0, 0, 0, 0, 324, 0, 0, 125, 125, 177, - 0, 0, 177, 0, 125, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 10, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 325, 0, 125, + 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, + 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, 0, 0, 0, 0, - 177, 0, 0, 0, 0, + 311, 0, 163, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 284, 0, 0, 0, 0, }; short yygindex[] = { 0, - 0, 0, 0, -158, 0, 0, -5, 298, 0, 0, - 0, 55, -157, -3, 4489, 520, 488, 0, 0, 0, - 0, 0, 364, 216, 527, 127, 0, 0, -147, 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, 0, }; -#define YYTABLESIZE 4759 +#define YYTABLESIZE 5988 short yytable[] = { 17, - 15, 20, 55, 228, 192, 237, 59, 193, 61, 182, - 74, 83, 76, 249, 251, 18, 85, 241, 87, 243, - 89, 84, 86, 88, 90, 195, 75, 135, 135, 135, - 154, 99, 156, 139, 140, 226, 106, 111, 15, 135, - 137, 138, 139, 140, 139, 119, 135, 135, 148, 123, - 80, 13, 149, 80, 146, 38, 147, 148, 82, 148, - 154, 149, 153, 149, 155, 151, 152, 80, 80, 13, - 80, 186, 25, 38, 196, 284, 281, 283, 165, 163, - 167, 166, 169, 168, 171, 170, 187, 173, 303, 15, - 15, 178, 153, 296, 15, 308, 323, 77, 298, 15, - 299, 15, 80, 15, 137, 25, 139, 140, 25, 25, - 25, 135, 25, 93, 25, 25, 94, 25, 135, 16, - 147, 148, 95, 198, 25, 149, 280, 199, 200, 201, - 202, 25, 315, 282, 16, 317, 25, 16, 17, 135, - 313, 314, 4, 5, 6, 7, 96, 319, 107, 229, - 230, 231, 232, 234, 301, 192, 17, 25, 193, 135, - 25, 25, 25, 25, 25, 129, 25, 25, 14, 25, - 227, 252, 329, 334, 306, 15, 18, 257, 259, 135, - 261, 242, 157, 25, 135, 235, 14, 264, 25, 137, - 138, 139, 140, 15, 321, 25, 236, 25, 25, 19, - 143, 144, 145, 146, 55, 147, 148, 55, 91, 18, - 149, 103, 18, 18, 18, 25, 18, 158, 18, 18, - 159, 18, 277, 78, 279, 245, 246, 26, 2, 131, - 132, 133, 134, 175, 288, 18, 289, 150, 290, 291, - 18, 176, 293, 151, 152, 295, 163, 25, 181, 25, - 25, 131, 132, 133, 134, 148, 300, 244, 55, 149, - 135, 39, 304, 185, 39, 39, 39, 18, 39, 184, - 39, 39, 191, 39, 135, 80, 80, 80, 80, 139, - 140, 4, 5, 6, 7, 240, 248, 39, 316, 135, - 320, 250, 39, 147, 148, 254, 161, 253, 149, 18, - 135, 18, 18, 260, 327, 266, 80, 135, 263, 278, - 285, 179, 80, 80, 61, 149, 292, 302, 297, 39, - 309, 331, 189, 310, 318, 190, 335, 322, 25, 25, - 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, - 25, 25, 324, 325, 326, 25, 25, 332, 25, 25, - 25, 39, 330, 333, 39, 25, 25, 25, 25, 25, - 25, 25, 37, 35, 138, 35, 25, 13, 37, 148, - 160, 25, 328, 25, 25, 70, 294, 0, 0, 0, + 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, + 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, 25, 25, 25, 25, 25, 25, 25, 25, 25, - 25, 25, 25, 25, 0, 255, 0, 25, 25, 0, - 25, 25, 25, 51, 0, 0, 51, 25, 25, 25, - 25, 25, 25, 25, 0, 0, 0, 0, 25, 0, - 51, 51, 0, 25, 0, 25, 25, 0, 0, 0, - 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 18, 0, 0, 0, 18, - 18, 286, 18, 18, 18, 51, 0, 0, 0, 18, - 18, 18, 18, 18, 18, 18, 270, 0, 0, 141, - 18, 142, 0, 0, 0, 18, 0, 18, 18, 0, - 0, 0, 0, 0, 39, 39, 39, 39, 39, 39, - 0, 0, 0, 307, 39, 39, 39, 39, 0, 0, - 311, 39, 39, 0, 39, 39, 39, 0, 0, 0, - 80, 39, 39, 39, 39, 39, 39, 39, 92, 0, - 0, 0, 39, 80, 101, 0, 104, 39, 146, 39, - 39, 146, 146, 146, 0, 146, 136, 146, 146, 136, - 146, 80, 80, 80, 80, 80, 0, 0, 0, 81, - 0, 0, 0, 136, 136, 0, 136, 0, 136, 146, - 0, 0, 97, 113, 114, 115, 116, 117, 110, 0, - 120, 121, 0, 0, 0, 0, 0, 0, 0, 0, - 124, 125, 126, 127, 128, 0, 146, 0, 136, 147, - 183, 0, 147, 147, 147, 0, 147, 99, 147, 147, - 99, 147, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 99, 99, 0, 99, 146, 99, - 147, 146, 180, 137, 138, 139, 140, 0, 51, 51, - 51, 51, 0, 0, 0, 144, 145, 146, 44, 147, - 148, 55, 57, 54, 149, 49, 0, 58, 52, 99, - 51, 0, 0, 0, 137, 138, 139, 140, 0, 51, - 137, 138, 139, 140, 50, 51, 51, 145, 146, 56, - 147, 148, 0, 0, 0, 149, 147, 148, 0, 0, - 0, 149, 147, 136, 0, 0, 0, 137, 138, 139, - 140, 0, 0, 0, 0, 0, 53, 0, 143, 144, - 145, 146, 0, 147, 148, 0, 0, 0, 149, 0, - 39, 0, 0, 39, 39, 39, 0, 39, 0, 39, - 39, 0, 39, 0, 0, 0, 0, 0, 15, 0, - 0, 45, 0, 0, 0, 0, 39, 0, 0, 0, - 0, 39, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 146, 146, 146, 146, 146, 0, 0, 0, - 0, 136, 136, 136, 136, 0, 0, 0, 39, 146, - 136, 146, 146, 146, 136, 136, 136, 136, 146, 146, - 146, 146, 146, 146, 146, 136, 136, 136, 136, 146, - 136, 136, 136, 0, 146, 136, 146, 146, 136, 136, - 39, 0, 0, 39, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 147, 147, 147, 147, 147, 0, 0, - 0, 0, 99, 99, 99, 99, 0, 0, 0, 0, - 147, 99, 147, 147, 147, 99, 99, 99, 99, 147, - 147, 147, 147, 147, 147, 147, 99, 99, 99, 99, - 147, 99, 99, 99, 0, 147, 99, 147, 147, 99, - 99, 21, 22, 23, 24, 25, 26, 0, 0, 0, - 0, 27, 28, 29, 30, 0, 0, 0, 31, 32, - 0, 33, 34, 35, 0, 0, 0, 0, 36, 37, - 38, 39, 40, 41, 42, 0, 0, 0, 0, 43, - 50, 0, 0, 50, 46, 0, 47, 48, 0, 0, - 0, 0, 0, 0, 0, 0, 44, 50, 50, 55, - 57, 54, 0, 49, 0, 58, 52, 0, 51, 0, - 0, 0, 0, 39, 39, 39, 39, 39, 39, 0, - 0, 0, 105, 39, 39, 39, 39, 56, 0, 0, - 39, 39, 50, 39, 39, 39, 0, 0, 0, 0, - 39, 39, 39, 39, 39, 39, 39, 0, 0, 0, - 0, 39, 0, 0, 53, 0, 39, 44, 39, 39, - 55, 57, 54, 0, 49, 118, 58, 52, 0, 51, - 0, 0, 0, 0, 0, 0, 0, 0, 77, 0, - 0, 77, 0, 0, 0, 0, 15, 0, 56, 45, - 0, 0, 0, 0, 0, 77, 77, 0, 77, 0, - 77, 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, - 77, 0, 0, 0, 0, 56, 0, 0, 0, 0, - 0, 79, 0, 0, 79, 0, 0, 15, 0, 0, - 45, 0, 0, 0, 0, 0, 0, 0, 79, 79, - 0, 79, 53, 79, 122, 0, 0, 0, 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, 79, 15, 0, 0, 45, 0, 56, - 0, 0, 0, 0, 0, 50, 50, 50, 50, 0, + 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, + 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, 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, 0, 0, 0, 0, 0, 0, 0, - 22, 23, 24, 25, 26, 0, 53, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 32, 0, 33, - 34, 35, 50, 50, 142, 0, 36, 37, 38, 39, - 40, 41, 42, 0, 0, 0, 0, 43, 15, 0, - 0, 45, 46, 0, 47, 48, 0, 0, 0, 0, - 71, 0, 0, 71, 0, 0, 0, 0, 0, 0, - 0, 22, 23, 24, 25, 26, 0, 71, 71, 0, - 71, 0, 71, 0, 0, 0, 0, 0, 32, 0, - 33, 34, 35, 77, 77, 77, 77, 36, 37, 38, - 39, 40, 41, 42, 0, 0, 0, 0, 43, 0, - 0, 0, 71, 46, 0, 47, 48, 0, 22, 23, - 24, 25, 26, 0, 77, 0, 0, 0, 0, 0, - 77, 77, 0, 0, 0, 32, 0, 33, 34, 35, - 141, 0, 142, 0, 36, 37, 38, 39, 40, 41, - 42, 0, 0, 0, 0, 43, 79, 79, 79, 79, - 46, 0, 47, 48, 44, 79, 0, 55, 57, 54, - 0, 49, 177, 58, 52, 0, 51, 0, 0, 0, - 79, 21, 22, 23, 24, 25, 26, 79, 0, 0, - 0, 0, 0, 79, 79, 56, 0, 0, 0, 32, - 0, 33, 34, 35, 0, 0, 0, 0, 36, 37, - 38, 39, 40, 41, 42, 0, 0, 0, 0, 43, - 0, 0, 53, 0, 46, 44, 47, 48, 55, 57, - 54, 0, 49, 0, 58, 52, 0, 51, 0, 0, - 0, 0, 0, 0, 0, 0, 136, 0, 0, 0, - 137, 138, 139, 140, 15, 0, 56, 45, 0, 0, - 0, 143, 144, 145, 146, 0, 147, 148, 0, 0, - 0, 149, 44, 0, 0, 55, 57, 54, 0, 49, - 0, 58, 52, 53, 51, 71, 71, 71, 71, 0, - 0, 0, 0, 0, 71, 0, 0, 0, 71, 71, - 207, 71, 0, 56, 0, 0, 0, 0, 0, 71, - 71, 71, 71, 0, 71, 15, 71, 0, 45, 0, - 0, 0, 71, 71, 0, 0, 0, 0, 0, 0, - 53, 0, 0, 0, 0, 0, 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, 15, 0, 209, 45, 0, 56, 0, 143, - 144, 145, 146, 0, 147, 148, 0, 0, 0, 149, - 0, 0, 0, 0, 0, 0, 0, 0, 22, 23, - 24, 25, 26, 0, 53, 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, - 42, 0, 0, 0, 0, 43, 15, 0, 0, 45, - 46, 0, 47, 48, 0, 0, 0, 0, 72, 0, - 0, 72, 0, 0, 0, 0, 0, 0, 0, 22, - 23, 24, 25, 26, 0, 72, 72, 0, 72, 0, - 72, 0, 0, 0, 0, 0, 32, 0, 33, 34, - 35, 0, 0, 0, 0, 36, 37, 38, 39, 40, - 41, 42, 0, 0, 0, 60, 43, 0, 60, 159, - 72, 46, 0, 47, 48, 0, 22, 23, 24, 25, - 26, 0, 60, 60, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 32, 0, 33, 34, 35, 0, 0, - 0, 0, 36, 37, 38, 39, 40, 41, 42, 0, - 0, 0, 0, 43, 0, 0, 0, 60, 46, 0, - 47, 48, 44, 0, 0, 55, 57, 54, 0, 49, - 0, 58, 52, 0, 51, 0, 0, 0, 0, 0, - 22, 23, 24, 25, 26, 0, 0, 0, 0, 0, - 213, 0, 0, 56, 0, 0, 0, 32, 0, 33, - 34, 35, 0, 0, 0, 0, 36, 37, 38, 39, - 40, 41, 42, 0, 0, 0, 0, 43, 0, 0, - 53, 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, 0, - 0, 215, 15, 0, 56, 45, 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, + 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, 0, 0, 0, 0, 0, 0, 0, - 44, 0, 0, 55, 57, 54, 0, 49, 0, 58, - 52, 53, 51, 72, 72, 72, 72, 0, 0, 0, - 0, 0, 72, 0, 0, 0, 72, 72, 217, 0, - 0, 56, 0, 0, 0, 0, 0, 72, 72, 72, - 72, 0, 72, 15, 72, 0, 45, 0, 0, 0, - 72, 72, 0, 0, 0, 0, 0, 0, 53, 0, - 60, 60, 60, 60, 44, 0, 0, 55, 57, 54, - 0, 49, 0, 58, 52, 0, 51, 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, 0, 0, 0, 0, 0, - 15, 60, 219, 45, 0, 56, 0, 60, 60, 0, + 0, 0, 0, 0, 22, 23, 24, 25, 26, 53, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 22, 23, 24, 25, - 26, 0, 53, 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, 42, 0, - 0, 0, 0, 43, 15, 0, 0, 45, 46, 0, - 47, 48, 0, 0, 0, 0, 70, 0, 0, 70, - 0, 0, 0, 0, 0, 0, 0, 22, 23, 24, - 25, 26, 0, 70, 70, 0, 70, 0, 70, 0, - 0, 0, 0, 0, 32, 0, 33, 34, 35, 0, - 0, 0, 0, 36, 37, 38, 39, 40, 41, 42, - 0, 0, 0, 62, 43, 0, 62, 0, 70, 46, - 0, 47, 48, 0, 22, 23, 24, 25, 26, 0, - 62, 62, 0, 0, 0, 0, 0, 0, 0, 0, 0, 32, 0, 33, 34, 35, 0, 0, 0, 0, - 36, 37, 38, 39, 40, 41, 42, 0, 0, 0, - 0, 43, 0, 0, 0, 62, 46, 0, 47, 48, - 44, 0, 0, 55, 57, 54, 0, 49, 0, 58, - 52, 0, 51, 0, 0, 0, 0, 0, 22, 23, - 24, 25, 26, 0, 0, 0, 0, 0, 221, 0, - 0, 56, 0, 0, 0, 32, 0, 33, 34, 35, - 0, 0, 0, 0, 36, 37, 38, 39, 40, 41, - 42, 0, 0, 0, 0, 43, 0, 0, 53, 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, 0, 0, 224, - 15, 0, 56, 45, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 44, 0, - 0, 55, 57, 54, 0, 49, 233, 58, 52, 53, - 51, 70, 70, 70, 70, 0, 0, 0, 0, 0, - 70, 0, 0, 0, 70, 70, 70, 70, 0, 56, - 0, 0, 0, 0, 0, 70, 70, 70, 70, 0, - 70, 15, 70, 0, 45, 0, 0, 0, 70, 70, - 0, 0, 0, 0, 0, 0, 53, 0, 62, 62, - 62, 62, 44, 0, 0, 55, 57, 54, 0, 49, - 256, 58, 52, 0, 51, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 15, 62, - 0, 45, 0, 56, 0, 62, 62, 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, 0, 0, 0, 22, 23, 24, 25, 26, 0, - 53, 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, 42, 0, 0, 0, - 0, 43, 15, 0, 0, 45, 46, 0, 47, 48, - 0, 0, 0, 0, 119, 0, 0, 119, 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, 0, 22, 23, 24, 25, 26, - 0, 119, 119, 0, 119, 0, 119, 0, 0, 0, + 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, 42, 0, 0, - 0, 63, 43, 0, 63, 0, 119, 46, 0, 47, - 48, 0, 22, 23, 24, 25, 26, 0, 63, 63, + 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, + 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, - 38, 39, 40, 41, 42, 0, 0, 0, 0, 43, - 0, 0, 0, 63, 46, 0, 47, 48, 44, 0, - 0, 55, 57, 54, 0, 49, 258, 58, 52, 0, - 51, 0, 0, 0, 0, 0, 22, 23, 24, 25, - 26, 0, 0, 0, 0, 0, 0, 0, 0, 56, - 0, 0, 0, 32, 0, 33, 34, 35, 0, 0, - 0, 0, 36, 37, 38, 39, 40, 41, 42, 0, - 0, 0, 0, 43, 0, 0, 53, 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, 262, 0, 0, 15, 0, - 56, 45, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 44, 0, 0, 55, - 57, 54, 0, 49, 265, 58, 52, 53, 51, 119, - 119, 119, 119, 0, 0, 0, 0, 0, 119, 0, - 0, 0, 119, 119, 0, 0, 0, 56, 0, 0, - 0, 0, 0, 119, 119, 119, 119, 0, 0, 15, - 119, 0, 45, 0, 0, 0, 119, 119, 0, 0, - 0, 0, 0, 0, 53, 0, 63, 63, 63, 63, - 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, 15, 63, 0, 45, - 0, 56, 0, 63, 63, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 22, 23, 24, 25, 26, 0, 53, 0, - 267, 0, 0, 0, 0, 0, 0, 0, 0, 32, + 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, 42, 0, 0, 0, 0, 43, - 15, 0, 0, 45, 46, 0, 47, 48, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 68, 0, 0, - 68, 0, 0, 22, 23, 24, 25, 26, 0, 0, - 0, 0, 0, 0, 68, 68, 0, 0, 0, 0, - 32, 0, 33, 34, 35, 0, 0, 0, 0, 36, - 37, 38, 39, 40, 41, 42, 0, 0, 125, 0, - 43, 125, 0, 0, 0, 46, 0, 47, 48, 68, - 22, 23, 24, 25, 26, 125, 125, 0, 125, 0, - 125, 0, 0, 0, 0, 0, 0, 32, 0, 33, - 34, 35, 0, 0, 0, 0, 36, 37, 38, 39, - 40, 41, 42, 0, 0, 0, 0, 43, 0, 0, - 125, 0, 46, 0, 47, 48, 44, 0, 0, 55, - 57, 54, 0, 49, 0, 58, 52, 0, 51, 0, - 0, 0, 0, 0, 22, 23, 24, 25, 26, 0, - 0, 0, 0, 0, 0, 0, 0, 56, 0, 0, - 0, 32, 0, 33, 34, 35, 0, 0, 0, 0, - 36, 37, 38, 39, 40, 41, 42, 0, 0, 0, - 0, 43, 0, 0, 53, 0, 46, 44, 47, 48, - 55, 57, 54, 0, 49, 0, 58, 52, 0, 51, + 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, + 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, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 15, 0, 56, 45, - 0, 0, 0, 0, 130, 0, 0, 130, 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, 0, 0, 0, - 0, 130, 130, 0, 130, 53, 130, 0, 0, 0, - 0, 0, 68, 68, 68, 68, 0, 0, 0, 0, - 0, 0, 0, 0, 138, 0, 0, 138, 0, 0, - 0, 0, 0, 0, 0, 0, 130, 15, 0, 0, - 45, 138, 138, 68, 138, 0, 138, 0, 0, 68, - 68, 0, 0, 125, 125, 125, 125, 0, 0, 0, - 0, 0, 125, 0, 0, 0, 125, 125, 125, 125, - 0, 0, 0, 0, 0, 0, 138, 125, 125, 125, - 125, 0, 125, 125, 125, 0, 0, 125, 0, 0, - 125, 125, 0, 0, 0, 0, 0, 0, 127, 0, - 0, 127, 0, 0, 0, 0, 0, 0, 0, 0, - 98, 23, 24, 25, 26, 127, 127, 0, 127, 0, - 127, 0, 0, 0, 0, 0, 0, 32, 0, 33, - 34, 35, 0, 0, 0, 0, 36, 37, 38, 39, - 40, 41, 42, 104, 0, 0, 104, 43, 0, 0, - 127, 0, 46, 0, 47, 48, 0, 0, 0, 0, - 104, 104, 0, 104, 0, 104, 0, 0, 0, 0, - 0, 22, 23, 24, 25, 26, 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, 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, 0, 0, 104, 0, 36, 37, 38, - 39, 40, 41, 42, 0, 0, 0, 0, 43, 130, - 130, 130, 130, 46, 0, 47, 48, 0, 130, 0, - 0, 0, 130, 130, 130, 130, 0, 0, 0, 0, - 0, 0, 0, 130, 130, 130, 130, 0, 130, 130, - 130, 0, 0, 130, 0, 0, 130, 130, 0, 138, - 138, 138, 138, 0, 0, 0, 0, 0, 138, 0, - 0, 0, 138, 138, 138, 138, 0, 0, 0, 0, - 0, 0, 0, 138, 138, 138, 138, 0, 138, 138, - 138, 115, 0, 138, 115, 0, 138, 138, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 115, 115, - 0, 115, 0, 115, 0, 0, 0, 0, 0, 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, 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, 127, 127, 127, 127, 0, 0, 0, - 0, 0, 127, 115, 0, 0, 127, 127, 127, 127, - 0, 0, 0, 0, 0, 0, 0, 127, 127, 127, - 127, 0, 127, 127, 127, 0, 136, 127, 0, 136, - 127, 127, 0, 0, 0, 0, 0, 0, 104, 104, - 104, 104, 0, 136, 136, 0, 136, 104, 136, 0, - 0, 104, 104, 104, 104, 0, 0, 0, 0, 0, - 0, 0, 104, 104, 104, 104, 0, 104, 104, 104, - 99, 0, 104, 99, 0, 104, 104, 0, 136, 0, - 0, 0, 0, 0, 0, 0, 0, 99, 99, 0, - 99, 0, 99, 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, 0, 0, - 0, 0, 99, 0, 0, 0, 94, 94, 0, 94, - 0, 94, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 93, 0, 0, 93, 0, 0, 0, 0, - 0, 94, 0, 0, 0, 0, 0, 0, 0, 93, - 93, 0, 93, 0, 93, 0, 115, 115, 115, 115, - 0, 0, 0, 0, 0, 115, 0, 0, 0, 115, - 115, 115, 115, 0, 0, 0, 0, 0, 139, 0, - 115, 115, 115, 115, 93, 115, 115, 115, 0, 0, - 115, 0, 0, 115, 115, 139, 139, 0, 139, 0, - 139, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 138, - 0, 0, 138, 0, 0, 0, 0, 0, 0, 0, - 139, 136, 136, 136, 136, 0, 138, 138, 0, 138, - 136, 138, 0, 0, 136, 136, 136, 136, 0, 0, - 0, 0, 0, 0, 0, 136, 136, 136, 136, 0, - 136, 136, 136, 0, 0, 136, 0, 0, 136, 136, - 0, 138, 0, 0, 0, 99, 99, 99, 99, 0, - 0, 0, 0, 0, 99, 0, 0, 0, 99, 99, - 99, 99, 0, 0, 0, 0, 0, 0, 0, 99, - 99, 99, 99, 0, 99, 99, 99, 0, 0, 99, - 0, 0, 99, 99, 94, 94, 94, 94, 0, 0, - 0, 0, 0, 94, 0, 0, 0, 94, 94, 94, - 94, 0, 0, 0, 0, 0, 0, 0, 94, 94, - 94, 94, 0, 94, 94, 94, 0, 81, 94, 0, - 81, 94, 94, 0, 0, 0, 0, 93, 93, 93, - 93, 0, 0, 0, 81, 81, 93, 81, 0, 81, - 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, - 0, 93, 93, 93, 93, 0, 93, 93, 93, 0, - 67, 93, 0, 67, 93, 93, 0, 0, 0, 81, - 0, 0, 0, 139, 139, 139, 139, 67, 67, 0, - 0, 0, 139, 0, 0, 0, 139, 139, 139, 139, - 0, 0, 0, 0, 0, 0, 0, 139, 139, 139, - 139, 0, 139, 139, 139, 0, 0, 139, 0, 0, - 139, 139, 67, 0, 138, 138, 138, 138, 0, 0, - 0, 0, 0, 138, 0, 0, 0, 138, 138, 138, - 138, 0, 0, 0, 0, 0, 0, 0, 138, 138, - 138, 138, 69, 138, 138, 69, 0, 0, 138, 0, - 0, 138, 138, 0, 0, 0, 0, 0, 0, 69, - 69, 0, 69, 0, 69, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 92, 0, 0, 92, 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, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 92, 92, 69, 92, 0, 92, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 129, 0, - 0, 129, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 129, 129, 92, 129, 0, - 129, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 81, 81, 81, 81, 0, 0, 0, 0, - 0, 81, 0, 0, 0, 81, 81, 81, 81, 0, - 129, 0, 0, 0, 0, 0, 81, 81, 81, 81, - 0, 81, 81, 81, 73, 0, 0, 73, 0, 81, - 81, 0, 0, 0, 0, 67, 67, 67, 67, 0, - 0, 73, 73, 0, 73, 0, 73, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 74, 0, 0, - 74, 0, 0, 0, 0, 0, 67, 0, 0, 0, - 0, 0, 67, 67, 74, 74, 73, 74, 0, 74, + 0, 82, 82, 82, 82, 0, 56, 0, 0, 0, + 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, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 66, 0, 0, - 66, 0, 0, 0, 0, 75, 0, 0, 75, 74, - 0, 0, 0, 0, 66, 66, 0, 69, 69, 69, - 69, 65, 75, 75, 65, 75, 69, 75, 0, 0, - 69, 69, 69, 69, 0, 0, 0, 0, 65, 65, - 0, 69, 69, 69, 69, 0, 69, 69, 69, 66, - 92, 92, 92, 92, 69, 69, 0, 75, 0, 92, - 0, 0, 0, 92, 92, 0, 0, 0, 0, 0, - 0, 0, 0, 65, 92, 92, 92, 92, 0, 0, - 0, 92, 0, 129, 129, 129, 129, 92, 92, 0, - 0, 0, 129, 0, 0, 76, 129, 129, 76, 0, - 0, 0, 0, 0, 0, 0, 0, 129, 129, 129, - 129, 0, 76, 76, 129, 76, 0, 76, 0, 0, - 129, 129, 0, 0, 0, 0, 0, 64, 0, 0, - 64, 0, 0, 0, 0, 0, 0, 78, 0, 0, - 78, 0, 0, 0, 64, 64, 0, 76, 0, 73, - 73, 73, 73, 61, 78, 78, 61, 78, 73, 78, - 0, 0, 0, 73, 0, 0, 0, 0, 0, 0, - 61, 61, 0, 73, 73, 73, 73, 0, 0, 64, - 73, 0, 74, 74, 74, 74, 73, 73, 0, 78, - 0, 74, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 61, 74, 74, 74, 74, - 0, 0, 0, 74, 0, 0, 0, 0, 85, 74, - 74, 85, 66, 66, 66, 66, 0, 0, 0, 0, - 75, 75, 75, 75, 0, 85, 85, 0, 85, 75, - 85, 0, 0, 0, 0, 0, 65, 65, 65, 65, - 0, 0, 0, 66, 75, 75, 75, 75, 0, 66, - 66, 75, 0, 0, 0, 0, 0, 75, 75, 0, - 85, 0, 86, 0, 0, 86, 0, 65, 0, 0, - 0, 0, 0, 65, 65, 0, 0, 0, 0, 86, - 86, 0, 86, 0, 86, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 87, 0, - 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, - 76, 76, 76, 76, 86, 87, 87, 0, 87, 76, - 87, 0, 0, 0, 0, 0, 0, 0, 0, 238, - 0, 0, 239, 0, 76, 76, 76, 0, 0, 0, - 0, 76, 64, 64, 64, 64, 0, 76, 76, 141, - 87, 142, 78, 78, 78, 78, 0, 0, 0, 0, - 0, 78, 0, 0, 83, 0, 0, 83, 61, 61, - 61, 61, 0, 64, 0, 0, 78, 78, 0, 64, - 64, 83, 83, 78, 83, 0, 83, 0, 0, 78, - 78, 0, 0, 0, 0, 0, 0, 0, 0, 61, - 84, 0, 0, 84, 0, 61, 61, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 83, 84, 84, 0, - 84, 0, 84, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 85, 85, 85, 85, 0, 0, 0, - 0, 0, 85, 0, 0, 0, 85, 85, 85, 85, - 0, 0, 84, 82, 0, 0, 82, 85, 85, 85, - 85, 0, 85, 85, 85, 0, 0, 85, 0, 0, - 82, 82, 0, 82, 0, 82, 0, 312, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, - 86, 0, 0, 0, 0, 0, 86, 141, 0, 142, - 86, 86, 86, 86, 0, 82, 0, 0, 0, 0, - 0, 86, 86, 86, 86, 0, 86, 86, 86, 0, - 0, 86, 0, 87, 87, 87, 87, 0, 0, 0, - 0, 0, 87, 0, 0, 0, 87, 87, 87, 87, - 0, 0, 0, 0, 0, 0, 0, 87, 87, 87, - 87, 0, 87, 87, 87, 0, 0, 87, 0, 0, - 0, 0, 0, 136, 0, 100, 102, 137, 138, 139, - 140, 112, 0, 0, 0, 0, 0, 0, 143, 144, - 145, 146, 0, 147, 148, 0, 0, 0, 149, 83, + 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, 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, 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, + 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, 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, 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, - 162, 0, 0, 83, 83, 83, 83, 0, 83, 83, - 83, 0, 0, 83, 0, 84, 84, 84, 84, 0, - 0, 0, 0, 0, 84, 0, 0, 0, 84, 84, - 84, 84, 0, 0, 0, 0, 0, 0, 0, 84, - 84, 84, 84, 0, 84, 84, 84, 0, 0, 84, - 0, 0, 0, 203, 204, 205, 206, 208, 210, 211, - 212, 214, 216, 218, 220, 222, 223, 225, 82, 82, - 82, 82, 0, 0, 0, 0, 0, 82, 0, 0, - 0, 82, 82, 82, 82, 0, 0, 0, 0, 0, - 0, 0, 82, 82, 82, 82, 0, 82, 82, 0, - 0, 136, 82, 0, 203, 137, 138, 139, 140, 0, - 0, 203, 0, 203, 0, 0, 143, 144, 145, 146, - 0, 147, 148, 0, 0, 268, 149, 269, 0, 0, - 0, 271, 0, 272, 0, 273, 0, 274, 0, 275, - 0, 0, 276, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 287, 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, 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, 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, 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, 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, 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, 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, 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, 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, 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, + 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, 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, + 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, + 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, + 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, 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, 305, + 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, 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, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 317, }; short yycheck[] = { 5, - 123, 59, 36, 91, 41, 125, 12, 44, 12, 40, - 16, 40, 18, 171, 173, 257, 40, 165, 40, 167, - 40, 27, 28, 29, 30, 44, 59, 44, 44, 44, - 91, 37, 91, 281, 282, 123, 40, 43, 123, 44, - 279, 280, 281, 282, 281, 49, 44, 44, 296, 53, - 41, 41, 300, 44, 293, 41, 295, 296, 40, 296, - 91, 300, 123, 300, 123, 303, 304, 58, 59, 59, - 61, 44, 0, 59, 93, 234, 93, 93, 84, 83, - 86, 85, 88, 87, 90, 89, 59, 91, 93, 123, - 123, 95, 123, 252, 123, 93, 93, 59, 257, 123, - 259, 123, 93, 123, 279, 33, 281, 282, 36, 37, - 38, 44, 40, 257, 42, 43, 40, 45, 44, 41, - 295, 296, 40, 129, 0, 300, 59, 131, 132, 133, - 134, 59, 290, 59, 257, 293, 64, 59, 41, 44, - 288, 289, 262, 263, 264, 265, 40, 295, 257, 153, - 154, 155, 156, 157, 59, 41, 59, 33, 44, 44, - 36, 37, 38, 91, 40, 272, 42, 43, 41, 45, - 258, 175, 320, 331, 59, 41, 0, 181, 182, 44, - 184, 41, 40, 59, 44, 278, 59, 191, 64, 279, - 280, 281, 282, 59, 59, 123, 289, 125, 126, 257, - 290, 291, 292, 293, 36, 295, 296, 36, 40, 33, - 300, 40, 36, 37, 38, 91, 40, 59, 42, 43, - 297, 45, 226, 257, 228, 270, 271, 261, 0, 266, - 267, 268, 269, 40, 240, 59, 242, 297, 244, 245, - 64, 41, 248, 303, 304, 251, 250, 123, 40, 125, - 126, 266, 267, 268, 269, 296, 260, 41, 36, 300, - 44, 33, 266, 125, 36, 37, 38, 91, 40, 123, - 42, 43, 91, 45, 44, 266, 267, 268, 269, 281, - 282, 262, 263, 264, 265, 41, 41, 59, 292, 44, - 296, 59, 64, 295, 296, 41, 81, 41, 300, 123, - 44, 125, 126, 123, 41, 91, 297, 44, 125, 40, - 40, 96, 303, 304, 318, 300, 40, 125, 41, 91, - 125, 327, 107, 125, 59, 110, 332, 125, 256, 257, + 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, + -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, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, - 268, 269, 125, 41, 41, 273, 274, 41, 276, 277, - 278, 123, 125, 41, 126, 283, 284, 285, 286, 287, - 288, 289, 41, 59, 41, 41, 294, 59, 59, 297, - 73, 299, 318, 301, 302, 12, 250, -1, -1, -1, - 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, - 266, 267, 268, 269, -1, 180, -1, 273, 274, -1, - 276, 277, 278, 41, -1, -1, 44, 283, 284, 285, - 286, 287, 288, 289, -1, -1, -1, -1, 294, -1, - 58, 59, -1, 299, -1, 301, 302, -1, -1, -1, - -1, -1, 256, 257, 258, 259, 260, 261, 262, 263, - 264, 265, 266, 267, 268, 269, -1, -1, -1, 273, - 274, 236, 276, 277, 278, 93, -1, -1, -1, 283, - 284, 285, 286, 287, 288, 289, 58, -1, -1, 61, - 294, 63, -1, -1, -1, 299, -1, 301, 302, -1, - -1, -1, -1, -1, 256, 257, 258, 259, 260, 261, - -1, -1, -1, 278, 266, 267, 268, 269, -1, -1, - 285, 273, 274, -1, 276, 277, 278, -1, -1, -1, - 23, 283, 284, 285, 286, 287, 288, 289, 31, -1, - -1, -1, 294, 36, 37, -1, 39, 299, 33, 301, - 302, 36, 37, 38, -1, 40, 41, 42, 43, 44, - 45, 54, 55, 56, 57, 58, -1, -1, -1, 23, - -1, -1, -1, 58, 59, -1, 61, -1, 63, 64, - -1, -1, 36, 44, 45, 46, 47, 48, 42, -1, - 51, 52, -1, -1, -1, -1, -1, -1, -1, -1, - 54, 55, 56, 57, 58, -1, 91, -1, 93, 33, - 103, -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, 96, 279, 280, 281, 282, -1, 266, 267, - 268, 269, -1, -1, -1, 291, 292, 293, 33, 295, - 296, 36, 37, 38, 300, 40, -1, 42, 43, 93, - 45, -1, -1, -1, 279, 280, 281, 282, -1, 297, - 279, 280, 281, 282, 59, 303, 304, 292, 293, 64, - 295, 296, -1, -1, -1, 300, 295, 296, -1, -1, - -1, 300, 126, 275, -1, -1, -1, 279, 280, 281, - 282, -1, -1, -1, -1, -1, 91, -1, 290, 291, - 292, 293, -1, 295, 296, -1, -1, -1, 300, -1, - 33, -1, -1, 36, 37, 38, -1, 40, -1, 42, - 43, -1, 45, -1, -1, -1, -1, -1, 123, -1, - -1, 126, -1, -1, -1, -1, 59, -1, -1, -1, - -1, 64, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 257, 258, 259, 260, 261, -1, -1, -1, - -1, 266, 267, 268, 269, -1, -1, -1, 91, 274, - 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, - 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, - 295, 296, 297, -1, 299, 300, 301, 302, 303, 304, - 123, -1, -1, 126, -1, -1, -1, -1, -1, -1, + 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, + 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, + 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, -1, 299, 300, 301, 302, 303, - 304, 256, 257, 258, 259, 260, 261, -1, -1, -1, - -1, 266, 267, 268, 269, -1, -1, -1, 273, 274, - -1, 276, 277, 278, -1, -1, -1, -1, 283, 284, - 285, 286, 287, 288, 289, -1, -1, -1, -1, 294, - 41, -1, -1, 44, 299, -1, 301, 302, -1, -1, - -1, -1, -1, -1, -1, -1, 33, 58, 59, 36, - 37, 38, -1, 40, -1, 42, 43, -1, 45, -1, - -1, -1, -1, 256, 257, 258, 259, 260, 261, -1, - -1, -1, 59, 266, 267, 268, 269, 64, -1, -1, - 273, 274, 93, 276, 277, 278, -1, -1, -1, -1, - 283, 284, 285, 286, 287, 288, 289, -1, -1, -1, - -1, 294, -1, -1, 91, -1, 299, 33, 301, 302, - 36, 37, 38, -1, 40, 41, 42, 43, -1, 45, - -1, -1, -1, -1, -1, -1, -1, -1, 41, -1, - -1, 44, -1, -1, -1, -1, 123, -1, 64, 126, - -1, -1, -1, -1, -1, 58, 59, -1, 61, -1, - 63, -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, - 93, -1, -1, -1, -1, 64, -1, -1, -1, -1, - -1, 41, -1, -1, 44, -1, -1, 123, -1, -1, - 126, -1, -1, -1, -1, -1, -1, -1, 58, 59, - -1, 61, 91, 63, 93, -1, -1, -1, 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, 93, 123, -1, -1, 126, -1, 64, - -1, -1, -1, -1, -1, 266, 267, 268, 269, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 257, 258, 259, 260, 261, -1, 91, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 297, 274, -1, 276, - 277, 278, 303, 304, 63, -1, 283, 284, 285, 286, - 287, 288, 289, -1, -1, -1, -1, 294, 123, -1, - -1, 126, 299, -1, 301, 302, -1, -1, -1, -1, - 41, -1, -1, 44, -1, -1, -1, -1, -1, -1, - -1, 257, 258, 259, 260, 261, -1, 58, 59, -1, - 61, -1, 63, -1, -1, -1, -1, -1, 274, -1, - 276, 277, 278, 266, 267, 268, 269, 283, 284, 285, - 286, 287, 288, 289, -1, -1, -1, -1, 294, -1, - -1, -1, 93, 299, -1, 301, 302, -1, 257, 258, - 259, 260, 261, -1, 297, -1, -1, -1, -1, -1, - 303, 304, -1, -1, -1, 274, -1, 276, 277, 278, - 61, -1, 63, -1, 283, 284, 285, 286, 287, 288, - 289, -1, -1, -1, -1, 294, 266, 267, 268, 269, - 299, -1, 301, 302, 33, 275, -1, 36, 37, 38, - -1, 40, 41, 42, 43, -1, 45, -1, -1, -1, - 290, 256, 257, 258, 259, 260, 261, 297, -1, -1, - -1, -1, -1, 303, 304, 64, -1, -1, -1, 274, - -1, 276, 277, 278, -1, -1, -1, -1, 283, 284, - 285, 286, 287, 288, 289, -1, -1, -1, -1, 294, - -1, -1, 91, -1, 299, 33, 301, 302, 36, 37, - 38, -1, 40, -1, 42, 43, -1, 45, -1, -1, - -1, -1, -1, -1, -1, -1, 275, -1, -1, -1, - 279, 280, 281, 282, 123, -1, 64, 126, -1, -1, - -1, 290, 291, 292, 293, -1, 295, 296, -1, -1, - -1, 300, 33, -1, -1, 36, 37, 38, -1, 40, - -1, 42, 43, 91, 45, 266, 267, 268, 269, -1, - -1, -1, -1, -1, 275, -1, -1, -1, 279, 280, - 61, 282, -1, 64, -1, -1, -1, -1, -1, 290, - 291, 292, 293, -1, 295, 123, 297, -1, 126, -1, - -1, -1, 303, 304, -1, -1, -1, -1, -1, -1, - 91, -1, -1, -1, -1, -1, 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, 123, -1, 61, 126, -1, 64, -1, 290, - 291, 292, 293, -1, 295, 296, -1, -1, -1, 300, - -1, -1, -1, -1, -1, -1, -1, -1, 257, 258, - 259, 260, 261, -1, 91, -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, - 289, -1, -1, -1, -1, 294, 123, -1, -1, 126, - 299, -1, 301, 302, -1, -1, -1, -1, 41, -1, - -1, 44, -1, -1, -1, -1, -1, -1, -1, 257, - 258, 259, 260, 261, -1, 58, 59, -1, 61, -1, - 63, -1, -1, -1, -1, -1, 274, -1, 276, 277, - 278, -1, -1, -1, -1, 283, 284, 285, 286, 287, - 288, 289, -1, -1, -1, 41, 294, -1, 44, 297, - 93, 299, -1, 301, 302, -1, 257, 258, 259, 260, - 261, -1, 58, 59, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 274, -1, 276, 277, 278, -1, -1, - -1, -1, 283, 284, 285, 286, 287, 288, 289, -1, - -1, -1, -1, 294, -1, -1, -1, 93, 299, -1, - 301, 302, 33, -1, -1, 36, 37, 38, -1, 40, - -1, 42, 43, -1, 45, -1, -1, -1, -1, -1, - 257, 258, 259, 260, 261, -1, -1, -1, -1, -1, - 61, -1, -1, 64, -1, -1, -1, 274, -1, 276, - 277, 278, -1, -1, -1, -1, 283, 284, 285, 286, - 287, 288, 289, -1, -1, -1, -1, 294, -1, -1, - 91, -1, 299, 33, 301, 302, 36, 37, 38, -1, - 40, -1, 42, 43, -1, 45, -1, -1, -1, -1, + 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, 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, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 61, 123, -1, 64, 126, -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, + 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, + 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, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 33, -1, -1, 36, 37, 38, -1, 40, -1, 42, - 43, 91, 45, 266, 267, 268, 269, -1, -1, -1, - -1, -1, 275, -1, -1, -1, 279, 280, 61, -1, - -1, 64, -1, -1, -1, -1, -1, 290, 291, 292, - 293, -1, 295, 123, 297, -1, 126, -1, -1, -1, - 303, 304, -1, -1, -1, -1, -1, -1, 91, -1, - 266, 267, 268, 269, 33, -1, -1, 36, 37, 38, - -1, 40, -1, 42, 43, -1, 45, -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, -1, -1, -1, -1, -1, - 123, 297, 61, 126, -1, 64, -1, 303, 304, -1, + -1, -1, -1, -1, 257, 258, 259, 260, 261, 91, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 257, 258, 259, 260, - 261, -1, 91, -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, 289, -1, - -1, -1, -1, 294, 123, -1, -1, 126, 299, -1, - 301, 302, -1, -1, -1, -1, 41, -1, -1, 44, - -1, -1, -1, -1, -1, -1, -1, 257, 258, 259, - 260, 261, -1, 58, 59, -1, 61, -1, 63, -1, - -1, -1, -1, -1, 274, -1, 276, 277, 278, -1, - -1, -1, -1, 283, 284, 285, 286, 287, 288, 289, - -1, -1, -1, 41, 294, -1, 44, -1, 93, 299, - -1, 301, 302, -1, 257, 258, 259, 260, 261, -1, - 58, 59, -1, -1, -1, -1, -1, -1, -1, -1, -1, 274, -1, 276, 277, 278, -1, -1, -1, -1, - 283, 284, 285, 286, 287, 288, 289, -1, -1, -1, - -1, 294, -1, -1, -1, 93, 299, -1, 301, 302, - 33, -1, -1, 36, 37, 38, -1, 40, -1, 42, - 43, -1, 45, -1, -1, -1, -1, -1, 257, 258, - 259, 260, 261, -1, -1, -1, -1, -1, 61, -1, - -1, 64, -1, -1, -1, 274, -1, 276, 277, 278, - -1, -1, -1, -1, 283, 284, 285, 286, 287, 288, - 289, -1, -1, -1, -1, 294, -1, -1, 91, -1, - 299, 33, 301, 302, 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, - 123, -1, 64, 126, -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, 266, 267, 268, 269, -1, -1, -1, -1, -1, - 275, -1, -1, -1, 279, 280, 281, 282, -1, 64, - -1, -1, -1, -1, -1, 290, 291, 292, 293, -1, - 295, 123, 297, -1, 126, -1, -1, -1, 303, 304, - -1, -1, -1, -1, -1, -1, 91, -1, 266, 267, - 268, 269, 33, -1, -1, 36, 37, 38, -1, 40, - 41, 42, 43, -1, 45, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 123, 297, - -1, 126, -1, 64, -1, 303, 304, -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, -1, -1, -1, 257, 258, 259, 260, 261, -1, - 91, -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, 289, -1, -1, -1, - -1, 294, 123, -1, -1, 126, 299, -1, 301, 302, - -1, -1, -1, -1, 41, -1, -1, 44, -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, -1, 257, 258, 259, 260, 261, - -1, 58, 59, -1, 61, -1, 63, -1, -1, -1, + 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, 289, -1, -1, - -1, 41, 294, -1, 44, -1, 93, 299, -1, 301, - 302, -1, 257, 258, 259, 260, 261, -1, 58, 59, + -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, + 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, - 285, 286, 287, 288, 289, -1, -1, -1, -1, 294, - -1, -1, -1, 93, 299, -1, 301, 302, 33, -1, - -1, 36, 37, 38, -1, 40, 41, 42, 43, -1, - 45, -1, -1, -1, -1, -1, 257, 258, 259, 260, - 261, -1, -1, -1, -1, -1, -1, -1, -1, 64, - -1, -1, -1, 274, -1, 276, 277, 278, -1, -1, - -1, -1, 283, 284, 285, 286, 287, 288, 289, -1, - -1, -1, -1, 294, -1, -1, 91, -1, 299, 33, - 301, 302, 36, 37, 38, -1, 40, -1, 42, 43, - -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 59, -1, -1, 123, -1, - 64, 126, -1, -1, -1, -1, -1, -1, -1, -1, + 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, + -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, -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, -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, 91, 45, 266, - 267, 268, 269, -1, -1, -1, -1, -1, 275, -1, - -1, -1, 279, 280, -1, -1, -1, 64, -1, -1, - -1, -1, -1, 290, 291, 292, 293, -1, -1, 123, - 297, -1, 126, -1, -1, -1, 303, 304, -1, -1, - -1, -1, -1, -1, 91, -1, 266, 267, 268, 269, - 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, 123, 297, -1, 126, - -1, 64, -1, 303, 304, -1, -1, -1, -1, -1, + 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, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 257, 258, 259, 260, 261, -1, 91, -1, - 93, -1, -1, -1, -1, -1, -1, -1, -1, 274, - -1, 276, 277, 278, -1, -1, -1, -1, 283, 284, - 285, 286, 287, 288, 289, -1, -1, -1, -1, 294, - 123, -1, -1, 126, 299, -1, 301, 302, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, - 44, -1, -1, 257, 258, 259, 260, 261, -1, -1, - -1, -1, -1, -1, 58, 59, -1, -1, -1, -1, - 274, -1, 276, 277, 278, -1, -1, -1, -1, 283, - 284, 285, 286, 287, 288, 289, -1, -1, 41, -1, - 294, 44, -1, -1, -1, 299, -1, 301, 302, 93, - 257, 258, 259, 260, 261, 58, 59, -1, 61, -1, - 63, -1, -1, -1, -1, -1, -1, 274, -1, 276, - 277, 278, -1, -1, -1, -1, 283, 284, 285, 286, - 287, 288, 289, -1, -1, -1, -1, 294, -1, -1, - 93, -1, 299, -1, 301, 302, 33, -1, -1, 36, - 37, 38, -1, 40, -1, 42, 43, -1, 45, -1, - -1, -1, -1, -1, 257, 258, 259, 260, 261, -1, - -1, -1, -1, -1, -1, -1, -1, 64, -1, -1, - -1, 274, -1, 276, 277, 278, -1, -1, -1, -1, - 283, 284, 285, 286, 287, 288, 289, -1, -1, -1, - -1, 294, -1, -1, 91, -1, 299, 33, 301, 302, - 36, 37, 38, -1, 40, -1, 42, 43, -1, 45, + -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, -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, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 123, -1, 64, 126, - -1, -1, -1, -1, 41, -1, -1, 44, -1, -1, + -1, -1, -1, -1, -1, 33, -1, -1, 36, 37, + 38, 91, 40, 41, 42, 43, -1, 45, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 58, 59, -1, 61, 91, 63, -1, -1, -1, - -1, -1, 266, 267, 268, 269, -1, -1, -1, -1, - -1, -1, -1, -1, 41, -1, -1, 44, -1, -1, - -1, -1, -1, -1, -1, -1, 93, 123, -1, -1, - 126, 58, 59, 297, 61, -1, 63, -1, -1, 303, - 304, -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, 93, 290, 291, 292, - 293, -1, 295, 296, 297, -1, -1, 300, -1, -1, - 303, 304, -1, -1, -1, -1, -1, -1, 41, -1, - -1, 44, -1, -1, -1, -1, -1, -1, -1, -1, - 257, 258, 259, 260, 261, 58, 59, -1, 61, -1, - 63, -1, -1, -1, -1, -1, -1, 274, -1, 276, - 277, 278, -1, -1, -1, -1, 283, 284, 285, 286, - 287, 288, 289, 41, -1, -1, 44, 294, -1, -1, - 93, -1, 299, -1, 301, 302, -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, -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, -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, -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, 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, 257, 258, 259, 260, 261, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 274, -1, - 276, 277, 278, -1, -1, 93, -1, 283, 284, 285, - 286, 287, 288, 289, -1, -1, -1, -1, 294, 266, - 267, 268, 269, 299, -1, 301, 302, -1, 275, -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, + -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, -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, -1, 290, 291, 292, 293, -1, 295, 296, - 297, -1, -1, 300, -1, -1, 303, 304, -1, 266, + -1, -1, 289, 290, -1, 292, 293, 294, 295, -1, + 297, 298, 299, -1, -1, -1, -1, -1, 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, 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, -1, -1, 279, 280, 281, 282, -1, -1, -1, -1, - -1, -1, -1, 290, 291, 292, 293, -1, 295, 296, - 297, 41, -1, 300, 44, -1, 303, 304, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 58, 59, - -1, 61, -1, 63, -1, -1, -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, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 266, 267, 268, 269, -1, -1, -1, - -1, -1, 275, 93, -1, -1, 279, 280, 281, 282, - -1, -1, -1, -1, -1, -1, -1, 290, 291, 292, - 293, -1, 295, 296, 297, -1, 41, 300, -1, 44, - 303, 304, -1, -1, -1, -1, -1, -1, 266, 267, - 268, 269, -1, 58, 59, -1, 61, 275, 63, -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, 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, 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, -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, - -1, -1, 290, 291, 292, 293, -1, 295, 296, 297, - 41, -1, 300, 44, -1, 303, 304, -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, -1, 41, - -1, -1, 44, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 93, -1, -1, -1, 58, 59, -1, 61, + 123, 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, + 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, -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, -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, 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, -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, -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, 93, -1, -1, -1, -1, -1, -1, -1, 58, - 59, -1, 61, -1, 63, -1, 266, 267, 268, 269, - -1, -1, -1, -1, -1, 275, -1, -1, -1, 279, - 280, 281, 282, -1, -1, -1, -1, -1, 41, -1, - 290, 291, 292, 293, 93, 295, 296, 297, -1, -1, - 300, -1, -1, 303, 304, 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, 266, 267, 268, 269, -1, 58, 59, -1, 61, - 275, 63, -1, -1, 279, 280, 281, 282, -1, -1, - -1, -1, -1, -1, -1, 290, 291, 292, 293, -1, - 295, 296, 297, -1, -1, 300, -1, -1, 303, 304, - -1, 93, -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, -1, 290, - 291, 292, 293, -1, 295, 296, 297, -1, -1, 300, - -1, -1, 303, 304, 266, 267, 268, 269, -1, -1, - -1, -1, -1, 275, -1, -1, -1, 279, 280, 281, - 282, -1, -1, -1, -1, -1, -1, -1, 290, 291, - 292, 293, -1, 295, 296, 297, -1, 41, 300, -1, - 44, 303, 304, -1, -1, -1, -1, 266, 267, 268, + -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, + -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, - -1, 290, 291, 292, 293, -1, 295, 296, 297, -1, - 41, 300, -1, 44, 303, 304, -1, -1, -1, 93, - -1, -1, -1, 266, 267, 268, 269, 58, 59, -1, - -1, -1, 275, -1, -1, -1, 279, 280, 281, 282, - -1, -1, -1, -1, -1, -1, -1, 290, 291, 292, - 293, -1, 295, 296, 297, -1, -1, 300, -1, -1, - 303, 304, 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, -1, 290, 291, - 292, 293, 41, 295, 296, 44, -1, -1, 300, -1, - -1, 303, 304, -1, -1, -1, -1, -1, -1, 58, - 59, -1, 61, -1, 63, -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, -1, 58, 59, 93, 61, -1, 63, -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, -1, -1, 58, 59, 93, 61, -1, + -1, -1, -1, 93, -1, 58, 59, -1, 61, -1, 63, -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, - 93, -1, -1, -1, -1, -1, 290, 291, 292, 293, - -1, 295, 296, 297, 41, -1, -1, 44, -1, 303, - 304, -1, -1, -1, -1, 266, 267, 268, 269, -1, - -1, 58, 59, -1, 61, -1, 63, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 41, -1, -1, - 44, -1, -1, -1, -1, -1, 297, -1, -1, -1, - -1, -1, 303, 304, 58, 59, 93, 61, -1, 63, + -1, -1, -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, 41, -1, -1, - 44, -1, -1, -1, -1, 41, -1, -1, 44, 93, - -1, -1, -1, -1, 58, 59, -1, 266, 267, 268, - 269, 41, 58, 59, 44, 61, 275, 63, -1, -1, - 279, 280, 281, 282, -1, -1, -1, -1, 58, 59, - -1, 290, 291, 292, 293, -1, 295, 296, 297, 93, - 266, 267, 268, 269, 303, 304, -1, 93, -1, 275, - -1, -1, -1, 279, 280, -1, -1, -1, -1, -1, - -1, -1, -1, 93, 290, 291, 292, 293, -1, -1, - -1, 297, -1, 266, 267, 268, 269, 303, 304, -1, - -1, -1, 275, -1, -1, 41, 279, 280, 44, -1, - -1, -1, -1, -1, -1, -1, -1, 290, 291, 292, - 293, -1, 58, 59, 297, 61, -1, 63, -1, -1, - 303, 304, -1, -1, -1, -1, -1, 41, -1, -1, - 44, -1, -1, -1, -1, -1, -1, 41, -1, -1, - 44, -1, -1, -1, 58, 59, -1, 93, -1, 266, - 267, 268, 269, 41, 58, 59, 44, 61, 275, 63, - -1, -1, -1, 280, -1, -1, -1, -1, -1, -1, - 58, 59, -1, 290, 291, 292, 293, -1, -1, 93, - 297, -1, 266, 267, 268, 269, 303, 304, -1, 93, - -1, 275, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 93, 290, 291, 292, 293, - -1, -1, -1, 297, -1, -1, -1, -1, 41, 303, - 304, 44, 266, 267, 268, 269, -1, -1, -1, -1, - 266, 267, 268, 269, -1, 58, 59, -1, 61, 275, - 63, -1, -1, -1, -1, -1, 266, 267, 268, 269, - -1, -1, -1, 297, 290, 291, 292, 293, -1, 303, - 304, 297, -1, -1, -1, -1, -1, 303, 304, -1, - 93, -1, 41, -1, -1, 44, -1, 297, -1, -1, - -1, -1, -1, 303, 304, -1, -1, -1, -1, 58, + 93, -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, 41, -1, - -1, 44, -1, -1, -1, -1, -1, -1, -1, -1, - 266, 267, 268, 269, 93, 58, 59, -1, 61, 275, - 63, -1, -1, -1, -1, -1, -1, -1, -1, 41, - -1, -1, 44, -1, 290, 291, 292, -1, -1, -1, - -1, 297, 266, 267, 268, 269, -1, 303, 304, 61, - 93, 63, 266, 267, 268, 269, -1, -1, -1, -1, - -1, 275, -1, -1, 41, -1, -1, 44, 266, 267, - 268, 269, -1, 297, -1, -1, 290, 291, -1, 303, - 304, 58, 59, 297, 61, -1, 63, -1, -1, 303, - 304, -1, -1, -1, -1, -1, -1, -1, -1, 297, - 41, -1, -1, 44, -1, 303, 304, -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, 266, 267, 268, 269, -1, -1, -1, - -1, -1, 275, -1, -1, -1, 279, 280, 281, 282, - -1, -1, 93, 41, -1, -1, 44, 290, 291, 292, - 293, -1, 295, 296, 297, -1, -1, 300, -1, -1, - 58, 59, -1, 61, -1, 63, -1, 41, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 266, 267, 268, - 269, -1, -1, -1, -1, -1, 275, 61, -1, 63, - 279, 280, 281, 282, -1, 93, -1, -1, -1, -1, - -1, 290, 291, 292, 293, -1, 295, 296, 297, -1, - -1, 300, -1, 266, 267, 268, 269, -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, -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, 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, -1, 290, 291, 292, - 293, -1, 295, 296, 297, -1, -1, 300, -1, -1, - -1, -1, -1, 275, -1, 37, 38, 279, 280, 281, - 282, 43, -1, -1, -1, -1, -1, -1, 290, 291, - 292, 293, -1, 295, 296, -1, -1, -1, 300, 266, - 267, 268, 269, -1, -1, -1, -1, -1, 275, -1, - -1, -1, 279, 280, 281, 282, -1, -1, -1, -1, - 82, -1, -1, 290, 291, 292, 293, -1, 295, 296, - 297, -1, -1, 300, -1, 266, 267, 268, 269, -1, - -1, -1, -1, -1, 275, -1, -1, -1, 279, 280, - 281, 282, -1, -1, -1, -1, -1, -1, -1, 290, - 291, 292, 293, -1, 295, 296, 297, -1, -1, 300, - -1, -1, -1, 135, 136, 137, 138, 139, 140, 141, - 142, 143, 144, 145, 146, 147, 148, 149, 266, 267, - 268, 269, -1, -1, -1, -1, -1, 275, -1, -1, - -1, 279, 280, 281, 282, -1, -1, -1, -1, -1, - -1, -1, 290, 291, 292, 293, -1, 295, 296, -1, - -1, 275, 300, -1, 186, 279, 280, 281, 282, -1, - -1, 193, -1, 195, -1, -1, 290, 291, 292, 293, - -1, 295, 296, -1, -1, 207, 300, 209, -1, -1, - -1, 213, -1, 215, -1, 217, -1, 219, -1, 221, - -1, -1, 224, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 239, -1, -1, + -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, + -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, + 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, -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, -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, -1, -1, -1, 270, + -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, }; #define YYFINAL 1 #ifndef YYDEBUG #define YYDEBUG 0 #endif -#define YYMAXTOKEN 304 +#define YYMAXTOKEN 306 #if YYDEBUG char *yyname[] = { "end-of-file",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, @@ -1198,8 +1449,8 @@ char *yyname[] = { "PMFUNC","PRIVATEREF","LABEL","FORMAT","SUB","PACKAGE","WHILE","UNTIL","IF", "UNLESS","ELSE","ELSIF","CONTINUE","FOR","LOOPEX","DOTDOT","FUNC0","FUNC1", "FUNC","RELOP","EQOP","MULOP","ADDOP","DOLSHARP","DO","LOCAL","DELETE", -"HASHBRACK","NOAMP","LSTOP","OROR","ANDAND","BITOROP","BITANDOP","UNIOP", -"SHIFTOP","MATCHOP","ARROW","UMINUS","REFGEN","POWOP","PREINC","PREDEC", +"HASHBRACK","NOAMP","OROP","ANDOP","LSTOP","OROR","ANDAND","BITOROP","BITANDOP", +"UNIOP","SHIFTOP","MATCHOP","ARROW","UMINUS","REFGEN","POWOP","PREINC","PREDEC", "POSTINC","POSTDEC", }; char *yyrule[] = { @@ -1283,6 +1534,8 @@ char *yyrule[] = { "sexpr : sexpr DOTDOT sexpr", "sexpr : sexpr ANDAND sexpr", "sexpr : sexpr OROR sexpr", +"sexpr : sexpr ANDOP sexpr", +"sexpr : sexpr OROP sexpr", "sexpr : sexpr '?' sexpr ':' sexpr", "sexpr : sexpr MATCHOP sexpr", "sexpr : term", @@ -1306,11 +1559,13 @@ char *yyrule[] = { "term : star", "term : scalar '[' expr ']'", "term : term ARROW '[' expr ']'", +"term : term '[' expr ']'", "term : hsh", "term : ary", "term : arylen", "term : scalar '{' expr ';' '}'", "term : term ARROW '{' expr ';' '}'", +"term : term '{' expr ';' '}'", "term : '(' expr crp '[' expr ']'", "term : '(' ')' '[' expr ']'", "term : ary '[' expr ']'", @@ -1322,6 +1577,7 @@ char *yyrule[] = { "term : amper '(' ')'", "term : amper '(' expr crp", "term : NOAMP WORD listexpr", +"term : NOAMP WORD indirob listexpr", "term : DO sexpr", "term : DO block", "term : DO WORD '(' ')'", @@ -1381,9 +1637,9 @@ int yyerrflag; int yychar; YYSTYPE yyval; YYSTYPE yylval; -#line 579 "perly.y" +#line 605 "perly.y" /* PROGRAM */ -#line 1392 "y.tab.c" +#line 1648 "y.tab.c" #define YYABORT goto yyabort #define YYACCEPT goto yyaccept #define YYERROR goto yyerrlab @@ -1571,7 +1827,7 @@ yyreduce: switch (yyn) { case 1: -#line 100 "perly.y" +#line 102 "perly.y" { #if defined(YYDEBUG) && defined(DEBUGGING) yydebug = (debug & 1); @@ -1580,7 +1836,7 @@ case 1: } break; case 2: -#line 107 "perly.y" +#line 109 "perly.y" { if (in_eval) { eval_root = newUNOP(OP_LEAVEEVAL, 0, yyvsp[0].opval); eval_start = linklist(eval_root); @@ -1592,36 +1848,43 @@ case 2: } break; case 3: -#line 119 "perly.y" -{ yyval.opval = scalarseq(yyvsp[-1].opval); - if (copline > (line_t)yyvsp[-3].ival) - copline = yyvsp[-3].ival; - leave_scope(yyvsp[-2].ival); - pad_leavemy(comppadnamefill); - expect = XBLOCK; } +#line 121 "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); + if (nbs) + needblockscope = TRUE; /* propagate outward */ + pad_leavemy(comppadnamefill); } break; case 4: -#line 128 "perly.y" -{ yyval.ival = savestack_ix; SAVEINT(comppadnamefill); } +#line 132 "perly.y" +{ yyval.ival = savestack_ix; + SAVEINT(comppadnamefill); + SAVEINT(needblockscope); + needblockscope = FALSE; } break; case 5: -#line 132 "perly.y" +#line 139 "perly.y" { yyval.opval = Nullop; } break; case 6: -#line 134 "perly.y" +#line 141 "perly.y" { yyval.opval = yyvsp[-1].opval; } break; case 7: -#line 136 "perly.y" -{ yyval.opval = append_list(OP_LINESEQ, yyvsp[-1].opval, yyvsp[0].opval); pad_reset(); } +#line 143 "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 140 "perly.y" +#line 149 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, yyvsp[0].opval); } break; case 10: -#line 143 "perly.y" +#line 152 "perly.y" { if (yyvsp[-1].pval != Nullch) { yyval.opval = newSTATEOP(0, yyvsp[-1].pval, newOP(OP_NULL, 0)); } @@ -1632,441 +1895,464 @@ case 10: expect = XBLOCK; } break; case 11: -#line 152 "perly.y" +#line 161 "perly.y" { yyval.opval = newSTATEOP(0, yyvsp[-2].pval, yyvsp[-1].opval); expect = XBLOCK; } break; case 12: -#line 157 "perly.y" +#line 166 "perly.y" { yyval.opval = Nullop; } break; case 13: -#line 159 "perly.y" +#line 168 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 14: -#line 161 "perly.y" +#line 170 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 15: -#line 163 "perly.y" +#line 172 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[0].opval, yyvsp[-2].opval); } break; case 16: -#line 165 "perly.y" +#line 174 "perly.y" { yyval.opval = newLOOPOP(0, 1, scalar(yyvsp[0].opval), yyvsp[-2].opval); } break; case 17: -#line 167 "perly.y" +#line 176 "perly.y" { yyval.opval = newLOOPOP(0, 1, invert(scalar(yyvsp[0].opval)), yyvsp[-2].opval);} break; case 18: -#line 171 "perly.y" +#line 180 "perly.y" { yyval.opval = Nullop; } break; case 19: -#line 173 "perly.y" +#line 182 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 20: -#line 175 "perly.y" +#line 184 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newCONDOP(0, yyvsp[-3].opval, scope(yyvsp[-1].opval), yyvsp[0].opval); } break; case 21: -#line 180 "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 22: -#line 183 "perly.y" +#line 192 "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 187 "perly.y" +#line 196 "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 190 "perly.y" +#line 199 "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 196 "perly.y" +#line 205 "perly.y" { yyval.opval = Nullop; } break; case 26: -#line 198 "perly.y" +#line 207 "perly.y" { yyval.opval = scope(yyvsp[0].opval); } break; case 27: -#line 202 "perly.y" +#line 211 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newSTATEOP(0, yyvsp[-6].pval, - newWHILEOP(0, 1, Nullop, yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) ); } + newWHILEOP(0, 1, (LOOP*)Nullop, + yyvsp[-3].opval, yyvsp[-1].opval, yyvsp[0].opval) ); } break; case 28: -#line 206 "perly.y" +#line 216 "perly.y" { copline = yyvsp[-5].ival; yyval.opval = newSTATEOP(0, yyvsp[-6].pval, - newWHILEOP(0, 1, Nullop, + newWHILEOP(0, 1, (LOOP*)Nullop, invert(scalar(yyvsp[-3].opval)), yyvsp[-1].opval, yyvsp[0].opval) ); } break; case 29: -#line 211 "perly.y" +#line 221 "perly.y" { copline = yyvsp[-3].ival; yyval.opval = newSTATEOP(0, yyvsp[-4].pval, - newWHILEOP(0, 1, Nullop, + newWHILEOP(0, 1, (LOOP*)Nullop, scope(yyvsp[-2].opval), yyvsp[-1].opval, yyvsp[0].opval) ); } break; case 30: -#line 216 "perly.y" +#line 226 "perly.y" { copline = yyvsp[-3].ival; yyval.opval = newSTATEOP(0, yyvsp[-4].pval, - newWHILEOP(0, 1, Nullop, + newWHILEOP(0, 1, (LOOP*)Nullop, invert(scalar(scope(yyvsp[-2].opval))), yyvsp[-1].opval, yyvsp[0].opval)); } break; case 31: -#line 221 "perly.y" -{ yyval.opval = newFOROP(0, yyvsp[-7].pval, yyvsp[-6].ival, ref(yyvsp[-5].opval, OP_ENTERLOOP), +#line 231 "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 224 "perly.y" +#line 234 "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 227 "perly.y" +#line 237 "perly.y" { copline = yyvsp[-8].ival; yyval.opval = append_elem(OP_LINESEQ, newSTATEOP(0, yyvsp[-9].pval, scalar(yyvsp[-6].opval)), newSTATEOP(0, yyvsp[-9].pval, - newWHILEOP(0, 1, Nullop, + newWHILEOP(0, 1, (LOOP*)Nullop, scalar(yyvsp[-4].opval), yyvsp[0].opval, scalar(yyvsp[-2].opval)) )); } break; case 34: -#line 234 "perly.y" +#line 244 "perly.y" { yyval.opval = newSTATEOP(0, - yyvsp[-2].pval, newWHILEOP(0, 1, Nullop, Nullop, yyvsp[-1].opval, yyvsp[0].opval)); } + yyvsp[-2].pval, newWHILEOP(0, 1, (LOOP*)Nullop, + Nullop, yyvsp[-1].opval, yyvsp[0].opval)); } break; case 35: -#line 239 "perly.y" +#line 250 "perly.y" { yyval.opval = Nullop; } break; case 37: -#line 244 "perly.y" +#line 255 "perly.y" { (void)scan_num("1"); yyval.opval = yylval.opval; } break; case 39: -#line 249 "perly.y" +#line 260 "perly.y" { yyval.pval = Nullch; } break; case 41: -#line 254 "perly.y" +#line 265 "perly.y" { yyval.ival = 0; } break; case 42: -#line 256 "perly.y" +#line 267 "perly.y" { yyval.ival = 0; } break; case 43: -#line 258 "perly.y" +#line 269 "perly.y" { yyval.ival = 0; } break; case 44: -#line 262 "perly.y" +#line 273 "perly.y" { newFORM(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 45: -#line 264 "perly.y" +#line 275 "perly.y" { newFORM(yyvsp[-1].ival, Nullop, yyvsp[0].opval); } break; case 46: -#line 268 "perly.y" +#line 279 "perly.y" { newSUB(yyvsp[-2].ival, yyvsp[-1].opval, yyvsp[0].opval); } break; case 47: -#line 270 "perly.y" -{ newSUB(yyvsp[-2].ival, yyvsp[-1].opval, Nullop); } +#line 281 "perly.y" +{ newSUB(yyvsp[-2].ival, yyvsp[-1].opval, Nullop); expect = XBLOCK; } break; case 48: -#line 274 "perly.y" +#line 285 "perly.y" { package(yyvsp[-1].opval); } break; case 49: -#line 276 "perly.y" +#line 287 "perly.y" { package(Nullop); } break; case 50: -#line 280 "perly.y" +#line 291 "perly.y" { yyval.opval = append_elem(OP_LIST, yyvsp[-2].opval, yyvsp[0].opval); } break; case 52: -#line 285 "perly.y" +#line 296 "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 288 "perly.y" +#line 299 "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 291 "perly.y" +#line 302 "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 294 "perly.y" +#line 305 "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 297 "perly.y" +#line 308 "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)); } break; case 57: -#line 300 "perly.y" +#line 311 "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)); } break; case 58: -#line 303 "perly.y" +#line 314 "perly.y" { yyval.opval = convert(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; case 59: -#line 305 "perly.y" +#line 316 "perly.y" { yyval.opval = convert(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; case 60: -#line 309 "perly.y" +#line 320 "perly.y" { yyval.opval = newASSIGNOP(OPf_STACKED, yyvsp[-2].opval, yyvsp[0].opval); } break; case 61: -#line 311 "perly.y" +#line 322 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, - ref(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } + mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 62: -#line 314 "perly.y" +#line 325 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, - ref(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } + mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 63: -#line 317 "perly.y" +#line 328 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, - ref(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval));} + mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval));} break; case 64: -#line 320 "perly.y" +#line 331 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, - ref(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } + mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 65: -#line 323 "perly.y" +#line 334 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, - ref(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } + mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 66: -#line 326 "perly.y" +#line 337 "perly.y" { yyval.opval = newBINOP(yyvsp[-2].ival, OPf_STACKED, - ref(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } + mod(scalar(yyvsp[-3].opval), yyvsp[-2].ival), scalar(yyvsp[0].opval)); } break; case 67: -#line 329 "perly.y" +#line 340 "perly.y" { yyval.opval = newLOGOP(OP_ANDASSIGN, 0, - ref(scalar(yyvsp[-3].opval), OP_ANDASSIGN), + mod(scalar(yyvsp[-3].opval), OP_ANDASSIGN), newUNOP(OP_SASSIGN, 0, scalar(yyvsp[0].opval))); } break; case 68: -#line 333 "perly.y" +#line 344 "perly.y" { yyval.opval = newLOGOP(OP_ORASSIGN, 0, - ref(scalar(yyvsp[-3].opval), OP_ORASSIGN), + mod(scalar(yyvsp[-3].opval), OP_ORASSIGN), newUNOP(OP_SASSIGN, 0, scalar(yyvsp[0].opval))); } break; case 69: -#line 339 "perly.y" +#line 350 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 70: -#line 341 "perly.y" +#line 352 "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 345 "perly.y" +#line 356 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 72: -#line 347 "perly.y" +#line 358 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 73: -#line 349 "perly.y" +#line 360 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 74: -#line 351 "perly.y" +#line 362 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 75: -#line 353 "perly.y" +#line 364 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 76: -#line 355 "perly.y" +#line 366 "perly.y" { yyval.opval = newBINOP(yyvsp[-1].ival, 0, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval)); } break; case 77: -#line 357 "perly.y" +#line 368 "perly.y" { yyval.opval = newRANGE(yyvsp[-1].ival, scalar(yyvsp[-2].opval), scalar(yyvsp[0].opval));} break; case 78: -#line 359 "perly.y" +#line 370 "perly.y" { yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 79: -#line 361 "perly.y" +#line 372 "perly.y" { yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 80: -#line 363 "perly.y" -{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } +#line 374 "perly.y" +{ yyval.opval = newLOGOP(OP_AND, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 81: -#line 365 "perly.y" -{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } +#line 376 "perly.y" +{ yyval.opval = newLOGOP(OP_OR, 0, yyvsp[-2].opval, yyvsp[0].opval); } break; case 82: -#line 367 "perly.y" -{ yyval.opval = yyvsp[0].opval; } +#line 378 "perly.y" +{ yyval.opval = newCONDOP(0, yyvsp[-4].opval, yyvsp[-2].opval, yyvsp[0].opval); } break; case 83: -#line 371 "perly.y" -{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } +#line 380 "perly.y" +{ yyval.opval = bind_match(yyvsp[-1].ival, yyvsp[-2].opval, yyvsp[0].opval); } break; case 84: -#line 373 "perly.y" +#line 382 "perly.y" { yyval.opval = yyvsp[0].opval; } break; case 85: -#line 375 "perly.y" -{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } +#line 386 "perly.y" +{ yyval.opval = newUNOP(OP_NEGATE, 0, scalar(yyvsp[0].opval)); } break; case 86: -#line 377 "perly.y" -{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} +#line 388 "perly.y" +{ yyval.opval = yyvsp[0].opval; } break; case 87: -#line 379 "perly.y" -{ yyval.opval = newUNOP(OP_REFGEN, 0, ref(yyvsp[0].opval, OP_REFGEN)); } +#line 390 "perly.y" +{ yyval.opval = newUNOP(OP_NOT, 0, scalar(yyvsp[0].opval)); } break; case 88: -#line 381 "perly.y" -{ yyval.opval = newUNOP(OP_POSTINC, 0, - ref(scalar(yyvsp[-1].opval), OP_POSTINC)); } +#line 392 "perly.y" +{ yyval.opval = newUNOP(OP_COMPLEMENT, 0, scalar(yyvsp[0].opval));} break; case 89: -#line 384 "perly.y" -{ yyval.opval = newUNOP(OP_POSTDEC, 0, - ref(scalar(yyvsp[-1].opval), OP_POSTDEC)); } +#line 394 "perly.y" +{ yyval.opval = newUNOP(OP_REFGEN, 0, mod(yyvsp[0].opval,OP_REFGEN)); } break; case 90: -#line 387 "perly.y" -{ yyval.opval = newUNOP(OP_PREINC, 0, - ref(scalar(yyvsp[0].opval), OP_PREINC)); } +#line 396 "perly.y" +{ yyval.opval = newUNOP(OP_POSTINC, 0, + mod(scalar(yyvsp[-1].opval), OP_POSTINC)); } break; case 91: -#line 390 "perly.y" -{ yyval.opval = newUNOP(OP_PREDEC, 0, - ref(scalar(yyvsp[0].opval), OP_PREDEC)); } +#line 399 "perly.y" +{ yyval.opval = newUNOP(OP_POSTDEC, 0, + mod(scalar(yyvsp[-1].opval), OP_POSTDEC)); } break; case 92: -#line 393 "perly.y" -{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } +#line 402 "perly.y" +{ yyval.opval = newUNOP(OP_PREINC, 0, + mod(scalar(yyvsp[0].opval), OP_PREINC)); } break; case 93: -#line 395 "perly.y" -{ yyval.opval = sawparens(yyvsp[-1].opval); } +#line 405 "perly.y" +{ yyval.opval = newUNOP(OP_PREDEC, 0, + mod(scalar(yyvsp[0].opval), OP_PREDEC)); } break; case 94: -#line 397 "perly.y" -{ yyval.opval = newNULLLIST(); } +#line 408 "perly.y" +{ yyval.opval = localize(yyvsp[0].opval,yyvsp[-1].ival); } break; case 95: -#line 399 "perly.y" -{ yyval.opval = newANONLIST(yyvsp[-1].opval); } +#line 410 "perly.y" +{ yyval.opval = sawparens(yyvsp[-1].opval); } break; case 96: -#line 401 "perly.y" -{ yyval.opval = newANONLIST(Nullop); } +#line 412 "perly.y" +{ yyval.opval = newNULLLIST(); } break; case 97: -#line 403 "perly.y" -{ yyval.opval = newANONHASH(yyvsp[-1].opval); } +#line 414 "perly.y" +{ yyval.opval = newANONLIST(yyvsp[-1].opval); } break; case 98: -#line 405 "perly.y" -{ yyval.opval = newANONHASH(Nullop); } +#line 416 "perly.y" +{ yyval.opval = newANONLIST(Nullop); } break; case 99: -#line 407 "perly.y" -{ yyval.opval = yyvsp[0].opval; } +#line 418 "perly.y" +{ yyval.opval = newANONHASH(yyvsp[-1].opval); } break; case 100: -#line 409 "perly.y" -{ yyval.opval = yyvsp[0].opval; } +#line 420 "perly.y" +{ yyval.opval = newANONHASH(Nullop); } break; case 101: -#line 411 "perly.y" -{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } +#line 422 "perly.y" +{ yyval.opval = yyvsp[0].opval; } break; case 102: -#line 413 "perly.y" +#line 424 "perly.y" +{ yyval.opval = yyvsp[0].opval; } +break; +case 103: +#line 426 "perly.y" +{ yyval.opval = newBINOP(OP_AELEM, 0, oopsAV(yyvsp[-3].opval), scalar(yyvsp[-1].opval)); } +break; +case 104: +#line 428 "perly.y" { yyval.opval = newBINOP(OP_AELEM, 0, scalar(ref(newAVREF(yyvsp[-4].opval),OP_RV2AV)), scalar(yyvsp[-1].opval));} break; -case 103: -#line 417 "perly.y" +case 105: +#line 432 "perly.y" +{ yyval.opval = newBINOP(OP_AELEM, 0, + scalar(ref(newAVREF(yyvsp[-3].opval),OP_RV2AV)), + scalar(yyvsp[-1].opval));} +break; +case 106: +#line 436 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 104: -#line 419 "perly.y" +case 107: +#line 438 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 105: -#line 421 "perly.y" +case 108: +#line 440 "perly.y" { yyval.opval = newUNOP(OP_AV2ARYLEN, 0, ref(yyvsp[0].opval, OP_AV2ARYLEN));} break; -case 106: -#line 423 "perly.y" +case 109: +#line 442 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; -case 107: -#line 426 "perly.y" +case 110: +#line 445 "perly.y" { yyval.opval = newBINOP(OP_HELEM, 0, scalar(ref(newHVREF(yyvsp[-5].opval),OP_RV2HV)), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; -case 108: -#line 431 "perly.y" +case 111: +#line 450 "perly.y" +{ yyval.opval = newBINOP(OP_HELEM, 0, + scalar(ref(newHVREF(yyvsp[-4].opval),OP_RV2HV)), + jmaybe(yyvsp[-2].opval)); + expect = XOPERATOR; } +break; +case 112: +#line 455 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, yyvsp[-4].opval); } break; -case 109: -#line 433 "perly.y" +case 113: +#line 457 "perly.y" { yyval.opval = newSLICEOP(0, yyvsp[-1].opval, Nullop); } break; -case 110: -#line 435 "perly.y" +case 114: +#line 459 "perly.y" { yyval.opval = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), list( @@ -2074,8 +2360,8 @@ case 110: list(yyvsp[-1].opval), ref(yyvsp[-3].opval, OP_ASLICE)))); } break; -case 111: -#line 442 "perly.y" +case 115: +#line 466 "perly.y" { yyval.opval = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), list( @@ -2084,194 +2370,198 @@ case 111: ref(oopsHV(yyvsp[-4].opval), OP_HSLICE)))); expect = XOPERATOR; } break; -case 112: -#line 450 "perly.y" +case 116: +#line 474 "perly.y" { yyval.opval = newBINOP(OP_DELETE, 0, oopsHV(yyvsp[-4].opval), jmaybe(yyvsp[-2].opval)); expect = XOPERATOR; } break; -case 113: -#line 453 "perly.y" +case 117: +#line 477 "perly.y" { yyval.opval = newBINOP(OP_DELETE, 0, oopsHV(yyvsp[-5].opval), jmaybe(yyvsp[-3].opval)); expect = XOPERATOR; } break; -case 114: -#line 456 "perly.y" +case 118: +#line 480 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 115: -#line 458 "perly.y" +case 119: +#line 482 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, 0, scalar(yyvsp[0].opval)); } break; -case 116: -#line 461 "perly.y" +case 120: +#line 485 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_STACKED, scalar(yyvsp[-2].opval)); } break; -case 117: -#line 463 "perly.y" +case 121: +#line 487 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_STACKED, list(prepend_elem(OP_LIST, scalar(yyvsp[-3].opval), yyvsp[-1].opval))); } break; -case 118: -#line 466 "perly.y" +case 122: +#line 490 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_STACKED, list(prepend_elem(OP_LIST, newCVREF(scalar(yyvsp[-1].opval)), yyvsp[0].opval))); } break; -case 119: -#line 470 "perly.y" -{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); - allgvs = TRUE;} +case 123: +#line 494 "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)); } break; -case 120: -#line 473 "perly.y" +case 124: +#line 497 "perly.y" +{ yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); } +break; +case 125: +#line 499 "perly.y" { yyval.opval = newUNOP(OP_NULL, OPf_SPECIAL, scope(yyvsp[0].opval)); } break; -case 121: -#line 475 "perly.y" +case 126: +#line 501 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, scalar(newCVREF(scalar(yyvsp[-2].opval))), newNULLLIST()))); } break; -case 122: -#line 479 "perly.y" +case 127: +#line 505 "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 123: -#line 484 "perly.y" +case 128: +#line 510 "perly.y" { yyval.opval = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, list(prepend_elem(OP_LIST, scalar(newCVREF(scalar(yyvsp[-2].opval))), newNULLLIST())));} break; -case 124: -#line 488 "perly.y" +case 129: +#line 514 "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 125: -#line 493 "perly.y" -{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); } +case 130: +#line 519 "perly.y" +{ yyval.opval = newOP(yyvsp[0].ival, OPf_SPECIAL); needblockscope = TRUE; } break; -case 126: -#line 495 "perly.y" +case 131: +#line 521 "perly.y" { yyval.opval = newPVOP(yyvsp[-1].ival, 0, - savestr(SvPVnx(((SVOP*)yyvsp[0].opval)->op_sv))); - op_free(yyvsp[0].opval); } + savestr(SvPVx(((SVOP*)yyvsp[0].opval)->op_sv, na))); + op_free(yyvsp[0].opval); needblockscope = TRUE; } break; -case 127: -#line 499 "perly.y" +case 132: +#line 525 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; -case 128: -#line 501 "perly.y" +case 133: +#line 527 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; -case 129: -#line 503 "perly.y" +case 134: +#line 529 "perly.y" { yyval.opval = newUNOP(yyvsp[-1].ival, 0, yyvsp[0].opval); } break; -case 130: -#line 505 "perly.y" +case 135: +#line 531 "perly.y" { yyval.opval = newOP(yyvsp[0].ival, 0); } break; -case 131: -#line 507 "perly.y" +case 136: +#line 533 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, 0); } break; -case 132: -#line 509 "perly.y" +case 137: +#line 535 "perly.y" { yyval.opval = newOP(yyvsp[-2].ival, OPf_SPECIAL); } break; -case 133: -#line 511 "perly.y" +case 138: +#line 537 "perly.y" { yyval.opval = newUNOP(yyvsp[-3].ival, 0, yyvsp[-1].opval); } break; -case 134: -#line 513 "perly.y" +case 139: +#line 539 "perly.y" { yyval.opval = pmruntime(yyvsp[-3].opval, yyvsp[-1].opval, Nullop); } break; -case 135: -#line 515 "perly.y" +case 140: +#line 541 "perly.y" { yyval.opval = pmruntime(yyvsp[-5].opval, yyvsp[-3].opval, yyvsp[-1].opval); } break; -case 138: -#line 521 "perly.y" +case 143: +#line 547 "perly.y" { yyval.opval = newNULLLIST(); } break; -case 139: -#line 523 "perly.y" +case 144: +#line 549 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 140: -#line 527 "perly.y" +case 145: +#line 553 "perly.y" { yyval.opval = newCVREF(yyvsp[0].opval); } break; -case 141: -#line 531 "perly.y" +case 146: +#line 557 "perly.y" { yyval.opval = newSVREF(yyvsp[0].opval); } break; -case 142: -#line 535 "perly.y" +case 147: +#line 561 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; -case 143: -#line 539 "perly.y" +case 148: +#line 565 "perly.y" { yyval.opval = newHVREF(yyvsp[0].opval); } break; -case 144: -#line 543 "perly.y" +case 149: +#line 569 "perly.y" { yyval.opval = newAVREF(yyvsp[0].opval); } break; -case 145: -#line 547 "perly.y" +case 150: +#line 573 "perly.y" { yyval.opval = newGVREF(yyvsp[0].opval); } break; -case 146: -#line 551 "perly.y" +case 151: +#line 577 "perly.y" { yyval.opval = scalar(yyvsp[0].opval); } break; -case 147: -#line 553 "perly.y" -{ yyval.opval = scalar(yyvsp[0].opval); } +case 152: +#line 579 "perly.y" +{ yyval.opval = scalar(yyvsp[0].opval); } break; -case 148: -#line 555 "perly.y" +case 153: +#line 581 "perly.y" { yyval.opval = scalar(scope(yyvsp[0].opval)); } break; -case 149: -#line 558 "perly.y" +case 154: +#line 584 "perly.y" { yyval.opval = yyvsp[0].opval; } break; -case 150: -#line 562 "perly.y" +case 155: +#line 588 "perly.y" { yyval.ival = 1; } break; -case 151: -#line 564 "perly.y" +case 156: +#line 590 "perly.y" { yyval.ival = 0; } break; -case 152: -#line 568 "perly.y" +case 157: +#line 594 "perly.y" { yyval.ival = 1; } break; -case 153: -#line 570 "perly.y" +case 158: +#line 596 "perly.y" { yyval.ival = 0; } break; -case 154: -#line 574 "perly.y" +case 159: +#line 600 "perly.y" { yyval.ival = 1; } break; -case 155: -#line 576 "perly.y" +case 160: +#line 602 "perly.y" { yyval.ival = 0; } break; -#line 2233 "y.tab.c" +#line 2523 "y.tab.c" } yyssp -= yym; yystate = *yyssp; @@ -30,22 +30,24 @@ #define DELETE 286 #define HASHBRACK 287 #define NOAMP 288 -#define LSTOP 289 -#define OROR 290 -#define ANDAND 291 -#define BITOROP 292 -#define BITANDOP 293 -#define UNIOP 294 -#define SHIFTOP 295 -#define MATCHOP 296 -#define ARROW 297 -#define UMINUS 298 -#define REFGEN 299 -#define POWOP 300 -#define PREINC 301 -#define PREDEC 302 -#define POSTINC 303 -#define POSTDEC 304 +#define OROP 289 +#define ANDOP 290 +#define LSTOP 291 +#define OROR 292 +#define ANDAND 293 +#define BITOROP 294 +#define BITANDOP 295 +#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 typedef union { I32 ival; char *pval; @@ -73,6 +73,8 @@ %type <pval> label %type <opval> cont +%left OROP +%left ANDOP %nonassoc <ival> LSTOP %left ',' %right '=' @@ -116,16 +118,21 @@ prog : /* NULL */ ; block : '{' remember lineseq '}' - { $$ = scalarseq($3); - if (copline > (line_t)$1) - copline = $1; - leave_scope($2); - pad_leavemy(comppadnamefill); - expect = XBLOCK; } + { int nbs = needblockscope; + $$ = scalarseq($3); + if (copline > (line_t)$1) + copline = $1; + leave_scope($2); + if (nbs) + needblockscope = TRUE; /* propagate outward */ + pad_leavemy(comppadnamefill); } ; remember: /* NULL */ /* in case they push a package name */ - { $$ = savestack_ix; SAVEINT(comppadnamefill); } + { $$ = savestack_ix; + SAVEINT(comppadnamefill); + SAVEINT(needblockscope); + needblockscope = FALSE; } ; lineseq : /* NULL */ @@ -133,7 +140,9 @@ lineseq : /* NULL */ | lineseq decl { $$ = $1; } | lineseq line - { $$ = append_list(OP_LINESEQ, $1, $2); pad_reset(); } + { $$ = append_list(OP_LINESEQ, + (LISTOP*)$1, (LISTOP*)$2); pad_reset(); + if ($1 && $2) needblockscope = TRUE; } ; line : label cond @@ -201,24 +210,25 @@ cont : /* NULL */ loop : label WHILE '(' texpr ')' block cont { copline = $2; $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, Nullop, $4, $6, $7) ); } + newWHILEOP(0, 1, (LOOP*)Nullop, + $4, $6, $7) ); } | label UNTIL '(' expr ')' block cont { copline = $2; $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, Nullop, + newWHILEOP(0, 1, (LOOP*)Nullop, invert(scalar($4)), $6, $7) ); } | label WHILE block block cont { copline = $2; $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, Nullop, + newWHILEOP(0, 1, (LOOP*)Nullop, scope($3), $4, $5) ); } | label UNTIL block block cont { copline = $2; $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, Nullop, + newWHILEOP(0, 1, (LOOP*)Nullop, invert(scalar(scope($3))), $4, $5)); } | label FOR scalar '(' expr crp block cont - { $$ = newFOROP(0, $1, $2, ref($3, OP_ENTERLOOP), + { $$ = newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP), $5, $7, $8); } | label FOR '(' expr crp block cont { $$ = newFOROP(0, $1, $2, Nullop, $4, $6, $7); } @@ -228,11 +238,12 @@ loop : label WHILE '(' texpr ')' block cont $$ = append_elem(OP_LINESEQ, newSTATEOP(0, $1, scalar($4)), newSTATEOP(0, $1, - newWHILEOP(0, 1, Nullop, + newWHILEOP(0, 1, (LOOP*)Nullop, scalar($6), $10, scalar($8)) )); } | label block cont /* a block is a loop that happens once */ { $$ = newSTATEOP(0, - $1, newWHILEOP(0, 1, Nullop, Nullop, $2, $3)); } + $1, newWHILEOP(0, 1, (LOOP*)Nullop, + Nullop, $2, $3)); } ; nexpr : /* NULL */ @@ -267,7 +278,7 @@ format : FORMAT WORD block subrout : SUB WORD block { newSUB($1, $2, $3); } | SUB WORD ';' - { newSUB($1, $2, Nullop); } + { newSUB($1, $2, Nullop); expect = XBLOCK; } ; package : PACKAGE WORD ';' @@ -309,29 +320,29 @@ sexpr : sexpr '=' sexpr { $$ = newASSIGNOP(OPf_STACKED, $1, $3); } | sexpr POWOP '=' sexpr { $$ = newBINOP($2, OPf_STACKED, - ref(scalar($1), $2), scalar($4)); } + mod(scalar($1), $2), scalar($4)); } | sexpr MULOP '=' sexpr { $$ = newBINOP($2, OPf_STACKED, - ref(scalar($1), $2), scalar($4)); } + mod(scalar($1), $2), scalar($4)); } | sexpr ADDOP '=' sexpr { $$ = newBINOP($2, OPf_STACKED, - ref(scalar($1), $2), scalar($4));} + mod(scalar($1), $2), scalar($4));} | sexpr SHIFTOP '=' sexpr { $$ = newBINOP($2, OPf_STACKED, - ref(scalar($1), $2), scalar($4)); } + mod(scalar($1), $2), scalar($4)); } | sexpr BITANDOP '=' sexpr { $$ = newBINOP($2, OPf_STACKED, - ref(scalar($1), $2), scalar($4)); } + mod(scalar($1), $2), scalar($4)); } | sexpr BITOROP '=' sexpr { $$ = newBINOP($2, OPf_STACKED, - ref(scalar($1), $2), scalar($4)); } + mod(scalar($1), $2), scalar($4)); } | sexpr ANDAND '=' sexpr { $$ = newLOGOP(OP_ANDASSIGN, 0, - ref(scalar($1), OP_ANDASSIGN), + mod(scalar($1), OP_ANDASSIGN), newUNOP(OP_SASSIGN, 0, scalar($4))); } | sexpr OROR '=' sexpr { $$ = newLOGOP(OP_ORASSIGN, 0, - ref(scalar($1), OP_ORASSIGN), + mod(scalar($1), OP_ORASSIGN), newUNOP(OP_SASSIGN, 0, scalar($4))); } @@ -359,6 +370,10 @@ sexpr : sexpr '=' sexpr { $$ = newLOGOP(OP_AND, 0, $1, $3); } | sexpr OROR sexpr { $$ = newLOGOP(OP_OR, 0, $1, $3); } + | sexpr ANDOP sexpr + { $$ = newLOGOP(OP_AND, 0, $1, $3); } + | sexpr OROP sexpr + { $$ = newLOGOP(OP_OR, 0, $1, $3); } | sexpr '?' sexpr ':' sexpr { $$ = newCONDOP(0, $1, $3, $5); } | sexpr MATCHOP sexpr @@ -376,19 +391,19 @@ term : '-' term %prec UMINUS | '~' term { $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2));} | REFGEN term - { $$ = newUNOP(OP_REFGEN, 0, ref($2, OP_REFGEN)); } + { $$ = newUNOP(OP_REFGEN, 0, mod($2,OP_REFGEN)); } | term POSTINC { $$ = newUNOP(OP_POSTINC, 0, - ref(scalar($1), OP_POSTINC)); } + mod(scalar($1), OP_POSTINC)); } | term POSTDEC { $$ = newUNOP(OP_POSTDEC, 0, - ref(scalar($1), OP_POSTDEC)); } + mod(scalar($1), OP_POSTDEC)); } | PREINC term { $$ = newUNOP(OP_PREINC, 0, - ref(scalar($2), OP_PREINC)); } + mod(scalar($2), OP_PREINC)); } | PREDEC term { $$ = newUNOP(OP_PREDEC, 0, - ref(scalar($2), OP_PREDEC)); } + mod(scalar($2), OP_PREDEC)); } | LOCAL sexpr %prec UNIOP { $$ = localize($2,$1); } | '(' expr crp @@ -413,6 +428,10 @@ term : '-' term %prec UMINUS { $$ = newBINOP(OP_AELEM, 0, scalar(ref(newAVREF($1),OP_RV2AV)), scalar($4));} + | term '[' expr ']' %prec '(' + { $$ = newBINOP(OP_AELEM, 0, + scalar(ref(newAVREF($1),OP_RV2AV)), + scalar($3));} | hsh %prec '(' { $$ = $1; } | ary %prec '(' @@ -427,6 +446,11 @@ term : '-' term %prec UMINUS scalar(ref(newHVREF($1),OP_RV2HV)), jmaybe($4)); expect = XOPERATOR; } + | term '{' expr ';' '}' %prec '(' + { $$ = newBINOP(OP_HELEM, 0, + scalar(ref(newHVREF($1),OP_RV2HV)), + jmaybe($3)); + expect = XOPERATOR; } | '(' expr crp '[' expr ']' %prec '(' { $$ = newSLICEOP(0, $5, $2); } | '(' ')' '[' expr ']' %prec '(' @@ -466,9 +490,11 @@ term : '-' term %prec UMINUS { $$ = newUNOP(OP_ENTERSUBR, OPf_STACKED, list(prepend_elem(OP_LIST, newCVREF(scalar($2)), $3))); } + | NOAMP WORD indirob listexpr + { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, + prepend_elem(OP_LIST, newMETHOD($3,$2), $4)); } | DO sexpr %prec UNIOP - { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); - allgvs = TRUE;} + { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); } | DO block %prec '(' { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); } | DO WORD '(' ')' @@ -490,11 +516,11 @@ term : '-' term %prec UMINUS scalar(newCVREF(scalar($2))), $4))); } | LOOPEX - { $$ = newOP($1, OPf_SPECIAL); } + { $$ = newOP($1, OPf_SPECIAL); needblockscope = TRUE; } | LOOPEX WORD { $$ = newPVOP($1, 0, - savestr(SvPVnx(((SVOP*)$2)->op_sv))); - op_free($2); } + savestr(SvPVx(((SVOP*)$2)->op_sv, na))); + op_free($2); needblockscope = TRUE; } | UNIOP { $$ = newOP($1, 0); } | UNIOP block @@ -550,7 +576,7 @@ star : '*' indirob indirob : WORD { $$ = scalar($1); } | scalar - { $$ = scalar($1); } + { $$ = scalar($1); } | block { $$ = scalar(scope($1)); } @@ -62,6 +62,8 @@ extern int h_errno; # include <varargs.h> #endif +static I32 dopoptosub P((I32 startingblock)); + /* Nothing. */ PP(pp_null) @@ -183,7 +185,7 @@ PP(pp_padav) dSP; dTARGET; XPUSHs(TARG); if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO) - av_clear(TARG); + av_clear((AV*)TARG); if (op->op_flags & OPf_LVAL) RETURN; PUTBACK; @@ -195,7 +197,7 @@ PP(pp_padhv) dSP; dTARGET; XPUSHs(TARG); if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO) - hv_clear(TARG, FALSE); + hv_clear((HV*)TARG); if (op->op_flags & OPf_LVAL) RETURN; PUTBACK; @@ -223,7 +225,7 @@ PP(pp_rv2gv) if (SvTYPE(sv) != SVt_PVGV) { if (!SvOK(sv)) DIE(no_usym); - sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE); + sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE); } } if (op->op_flags & OPf_INTRO) { @@ -272,12 +274,29 @@ PP(pp_rv2sv) } } else { - if (SvTYPE(sv) != SVt_PVGV) { + GV *gv = sv; + if (SvTYPE(gv) != SVt_PVGV) { if (!SvOK(sv)) DIE(no_usym); - sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE); + gv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE); + } + sv = GvSV(gv); + if (op->op_private == OP_RV2HV && + (SvTYPE(sv) != SVt_REF || SvTYPE((SV*)SvANY(sv)) != SVt_PVHV)) { + sv_free(sv); + sv = NEWSV(0,0); + sv_upgrade(sv, SVt_REF); + SvANY(sv) = (void*)sv_ref((SV*)newHV()); + GvSV(gv) = sv; + } + else if (op->op_private == OP_RV2AV && + (SvTYPE(sv) != SVt_REF || SvTYPE((SV*)SvANY(sv)) != SVt_PVAV)) { + sv_free(sv); + sv = NEWSV(0,0); + sv_upgrade(sv, SVt_REF); + SvANY(sv) = (void*)sv_ref((SV*)newAV()); + GvSV(gv) = sv; } - sv = GvSV(sv); } if (op->op_flags & OPf_INTRO) SETs(save_scalar((GV*)TOPs)); @@ -327,11 +346,18 @@ PP(pp_refgen) PP(pp_ref) { - dSP; dTARGET; dTOPss; + dSP; dTARGET; + SV *sv; char *pv; + if (MAXARG < 1) { + sv = GvSV(defgv); + EXTEND(SP, 1); + } + else + sv = POPs; if (SvTYPE(sv) != SVt_REF) - RETSETUNDEF; + RETPUSHUNDEF; sv = (SV*)SvANY(sv); if (SvSTORAGE(sv) == 'O') @@ -356,24 +382,31 @@ PP(pp_ref) default: pv = "UNKNOWN"; break; } } - SETp(pv, strlen(pv)); + PUSHp(pv, strlen(pv)); RETURN; } PP(pp_bless) { - dSP; dTOPss; + dSP; register SV* ref; + SV *sv; + HV *stash; - if (SvTYPE(sv) != SVt_REF) - RETSETUNDEF; + if (MAXARG == 1) + stash = curcop->cop_stash; + else + stash = fetch_stash(POPs, TRUE); + sv = TOPs; + if (SvTYPE(sv) != SVt_REF) + DIE("Can't bless non-reference value"); ref = (SV*)SvANY(sv); if (SvSTORAGE(ref) && SvSTORAGE(ref) != 'O') DIE("Can't bless temporary scalar"); SvSTORAGE(ref) = 'O'; SvUPGRADE(ref, SVt_PVMG); - SvSTASH(ref) = curcop->cop_stash; + SvSTASH(ref) = stash; RETURN; } @@ -384,9 +417,7 @@ PP(pp_backtick) dSP; dTARGET; FILE *fp; char *tmps = POPp; -#ifdef TAINT TAINT_PROPER("``"); -#endif fp = my_popen(tmps, "r"); if (fp) { sv_setpv(TARG, ""); /* note that this preserves previous buffer */ @@ -408,7 +439,7 @@ PP(pp_backtick) XPUSHs(sv_2mortal(sv)); if (SvLEN(sv) - SvCUR(sv) > 20) { SvLEN_set(sv, SvCUR(sv)+1); - Renew(SvPV(sv), SvLEN(sv), char); + Renew(SvPVX(sv), SvLEN(sv), char); } } } @@ -472,7 +503,7 @@ do_readline() sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|"); #endif /* !CSH */ #endif /* !MSDOS */ - (void)do_open(last_in_gv, SvPV(tmpcmd), SvCUR(tmpcmd)); + (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd)); fp = io->ifp; sv_free(tmpcmd); } @@ -521,9 +552,10 @@ do_readline() } io->lines++; XPUSHs(sv); -#ifdef TAINT - sv->sv_tainted = 1; /* Anything from the outside world...*/ -#endif + if (tainting) { + tainted = TRUE; + SvTAINT(sv); /* Anything from the outside world...*/ + } if (type == OP_GLOB) { char *tmps; @@ -533,11 +565,11 @@ do_readline() *SvEND(sv) = '\0'; else SvCUR(sv)++; - for (tmps = SvPV(sv); *tmps; tmps++) + for (tmps = SvPVX(sv); *tmps; tmps++) if (!isALPHA(*tmps) && !isDIGIT(*tmps) && strchr("$&*(){}[]'\";\\|?<>~`", *tmps)) break; - if (*tmps && stat(SvPV(sv), &statbuf) < 0) { + if (*tmps && stat(SvPVX(sv), &statbuf) < 0) { POPs; /* Unmatched wildcard? Chuck it... */ continue; } @@ -545,7 +577,7 @@ do_readline() if (GIMME == G_ARRAY) { if (SvLEN(sv) - SvCUR(sv) > 20) { SvLEN_set(sv, SvCUR(sv)+1); - Renew(SvPV(sv), SvLEN(sv), char); + Renew(SvPVX(sv), SvLEN(sv), char); } sv = sv_2mortal(NEWSV(58, 80)); continue; @@ -556,7 +588,7 @@ do_readline() SvLEN_set(sv, 80); else SvLEN_set(sv, SvCUR(sv)+40); /* allow some slop */ - Renew(SvPV(sv), SvLEN(sv), char); + Renew(SvPVX(sv), SvLEN(sv), char); } RETURN; } @@ -595,7 +627,7 @@ PP(pp_readline) PP(pp_indread) { - last_in_gv = gv_fetchpv(SvPVnx(GvSV((GV*)(*stack_sp--))), TRUE); + last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE); return do_readline(); } @@ -605,6 +637,11 @@ PP(pp_rcatline) return do_readline(); } +PP(pp_regcmaybe) +{ + return NORMAL; +} + PP(pp_regcomp) { dSP; register PMOP *pm = (PMOP*)cLOGOP->op_other; @@ -612,14 +649,15 @@ PP(pp_regcomp) { I32 global; SV *tmpstr; register REGEXP *rx = pm->op_pmregexp; + STRLEN len; global = pm->op_pmflags & PMf_GLOBAL; tmpstr = POPs; - t = SvPVn(tmpstr); + t = SvPV(tmpstr, len); if (!global && rx) regfree(rx); pm->op_pmregexp = Null(REGEXP*); /* crucial if regcomp aborts */ - pm->op_pmregexp = regcomp(t, t + SvCUROK(tmpstr), + pm->op_pmregexp = regcomp(t, t + len, pm->op_pmflags & PMf_FOLD); if (!pm->op_pmregexp->prelen && curpm) pm = curpm; @@ -629,8 +667,7 @@ PP(pp_regcomp) { pm->op_pmregexp->prelen); pm->op_pmflags &= ~PMf_RUNTIME; /* no point compiling again */ hoistmust(pm); - op->op_type = OP_NULL; - op->op_ppaddr = ppaddr[OP_NULL]; + cLOGOP->op_first->op_next = op->op_next; /* XXX delete push code */ } RETURN; @@ -649,6 +686,7 @@ PP(pp_match) char *truebase; register REGEXP *rx = pm->op_pmregexp; I32 gimme = GIMME; + STRLEN len; if (op->op_flags & OPf_STACKED) TARG = POPs; @@ -656,8 +694,8 @@ PP(pp_match) TARG = GvSV(defgv); EXTEND(SP,1); } - s = SvPVn(TARG); - strend = s + SvCUROK(TARG); + s = SvPV(TARG, len); + strend = s + len; if (!s) DIE("panic: do_match"); @@ -717,10 +755,10 @@ play_it_again: s = t; } else if (!multiline) { - if (*SvPV(pm->op_pmshort) != *s || - bcmp(SvPV(pm->op_pmshort), s, pm->op_pmslen) ) { + if (*SvPVX(pm->op_pmshort) != *s || + bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) { if (pm->op_pmflags & PMf_FOLD) { - if (ibcmp(SvPV(pm->op_pmshort), s, pm->op_pmslen) ) + if (ibcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) goto nope; } else @@ -843,7 +881,7 @@ PP(pp_subst) register char *m; char *c; register char *d; - I32 clen; + STRLEN clen; I32 iters = 0; I32 maxiters; register I32 i; @@ -851,6 +889,7 @@ PP(pp_subst) char *orig; I32 safebase; register REGEXP *rx = pm->op_pmregexp; + STRLEN len; if (pm->op_pmflags & PMf_CONST) /* known replacement string? */ dstr = POPs; @@ -860,11 +899,11 @@ PP(pp_subst) TARG = GvSV(defgv); EXTEND(SP,1); } - s = SvPVn(TARG); + s = SvPV(TARG, len); if (!pm || !s) DIE("panic: do_subst"); - strend = s + SvCUROK(TARG); + strend = s + len; maxiters = (strend - s) + 10; if (!rx->prelen && curpm) { @@ -894,10 +933,10 @@ PP(pp_subst) s = m; } else if (!multiline) { - if (*SvPV(pm->op_pmshort) != *s || - bcmp(SvPV(pm->op_pmshort), s, pm->op_pmslen) ) { + if (*SvPVX(pm->op_pmshort) != *s || + bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) { if (pm->op_pmflags & PMf_FOLD) { - if (ibcmp(SvPV(pm->op_pmshort), s, pm->op_pmslen) ) + if (ibcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) goto nope; } else @@ -911,8 +950,7 @@ PP(pp_subst) } once = !(rpm->op_pmflags & PMf_GLOBAL); if (rpm->op_pmflags & PMf_CONST) { /* known replacement string? */ - c = SvPVn(dstr); - clen = SvCUROK(dstr); + c = SvPV(dstr, clen); if (clen <= rx->minlen) { /* can do inplace substitution */ if (regexec(rx, s, strend, orig, 0, @@ -938,7 +976,7 @@ PP(pp_subst) } *m = '\0'; SvCUR_set(TARG, m - s); - SvNOK_off(TARG); + SvPOK_only(TARG); SvSETMAGIC(TARG); PUSHs(&sv_yes); RETURN; @@ -953,7 +991,7 @@ PP(pp_subst) *--d = *--s; if (clen) Copy(c, m, clen, char); - SvNOK_off(TARG); + SvPOK_only(TARG); SvSETMAGIC(TARG); PUSHs(&sv_yes); RETURN; @@ -962,14 +1000,14 @@ PP(pp_subst) d -= clen; sv_chop(TARG, d); Copy(c, d, clen, char); - SvNOK_off(TARG); + SvPOK_only(TARG); SvSETMAGIC(TARG); PUSHs(&sv_yes); RETURN; } else { sv_chop(TARG, d); - SvNOK_off(TARG); + SvPOK_only(TARG); SvSETMAGIC(TARG); PUSHs(&sv_yes); RETURN; @@ -995,10 +1033,10 @@ PP(pp_subst) Nullsv, TRUE)); /* (don't match same null twice) */ if (s != d) { i = strend - s; - SvCUR_set(TARG, d - SvPV(TARG) + i); + SvCUR_set(TARG, d - SvPVX(TARG) + i); Move(s, d, i+1, char); /* include the Null */ } - SvNOK_off(TARG); + SvPOK_only(TARG); SvSETMAGIC(TARG); PUSHs(sv_2mortal(newSVnv((double)iters))); RETURN; @@ -1041,7 +1079,7 @@ PP(pp_subst) safebase)); sv_catpvn(dstr, s, strend - s); sv_replace(TARG, dstr); - SvNOK_off(TARG); + SvPOK_only(TARG); SvSETMAGIC(TARG); PUSHs(sv_2mortal(newSVnv((double)iters))); RETURN; @@ -1082,7 +1120,7 @@ PP(pp_substcont) SV *targ = cx->sb_targ; sv_catpvn(dstr, s, cx->sb_strend - s); sv_replace(targ, dstr); - SvNOK_off(targ); + SvPOK_only(targ); SvSETMAGIC(targ); PUSHs(sv_2mortal(newSVnv((double)(cx->sb_iters - 1)))); POPSUBST(cx); @@ -1126,10 +1164,9 @@ PP(pp_trans) PP(pp_sassign) { dSP; dPOPTOPssrl; -#ifdef TAINT - if (tainted && !lstr->sv_tainted) + if (tainting && tainted && (!SvMAGICAL(lstr) || !mg_find(lstr, 't'))) { TAINT_NOT; -#endif + } SvSetSV(rstr, lstr); SvSETMAGIC(rstr); SETs(rstr); @@ -1152,6 +1189,7 @@ PP(pp_aassign) HV *hash; I32 i; + int magic; delaymagic = DM_DELAY; /* catch simultaneous items */ @@ -1176,6 +1214,7 @@ PP(pp_aassign) switch (SvTYPE(sv)) { case SVt_PVAV: ary = (AV*)sv; + magic = SvMAGICAL(ary) != 0; AvREAL_on(ary); AvFILL(ary) = -1; i = 0; @@ -1185,28 +1224,32 @@ PP(pp_aassign) sv_setsv(sv,*relem); *(relem++) = sv; (void)av_store(ary,i++,sv); + if (magic) + mg_set(sv); } break; case SVt_PVHV: { char *tmps; SV *tmpstr; - MAGIC* magic = 0; - I32 magictype; hash = (HV*)sv; - hv_clear(hash, TRUE); /* wipe any dbm file too */ + magic = SvMAGICAL(hash) != 0; + hv_clear(hash); while (relem < lastrelem) { /* gobble up all the rest */ + STRLEN len; if (*relem) sv = *(relem++); else sv = &sv_no, relem++; - tmps = SvPVn(sv); + tmps = SvPV(sv, len); tmpstr = NEWSV(29,0); if (*relem) sv_setsv(tmpstr,*relem); /* value */ *(relem++) = tmpstr; - (void)hv_store(hash,tmps,SvCUROK(sv),tmpstr,0); + (void)hv_store(hash,tmps,len,tmpstr,0); + if (magic) + mg_set(tmpstr); } } break; @@ -1279,6 +1322,7 @@ PP(pp_aassign) gid = (int)getgid(); egid = (int)getegid(); } + tainting |= (euid != uid || egid != gid); } delaymagic = 0; if (GIMME == G_ARRAY) { @@ -1367,23 +1411,26 @@ PP(pp_undef) switch (SvTYPE(sv)) { case SVt_NULL: break; + case SVt_REF: + sv_free((SV*)SvANY(sv)); + SvANY(sv) = 0; + SvTYPE(sv) = SVt_NULL; + break; case SVt_PVAV: av_undef((AV*)sv); break; case SVt_PVHV: - hv_undef((HV*)sv, TRUE); + hv_undef((HV*)sv); break; - case SVt_PVCV: { - CV *cv = (CV*)sv; - op_free(CvROOT(cv)); - CvROOT(cv) = 0; + case SVt_PVCV: + sub_generation++; + cv_clear((CV*)sv); break; - } default: if (sv != GvSV(defgv)) { if (SvPOK(sv) && SvLEN(sv)) { SvOOK_off(sv); - Safefree(SvPV(sv)); + Safefree(SvPVX(sv)); SvPV_set(sv, Nullch); SvLEN_set(sv, 0); } @@ -1404,9 +1451,10 @@ PP(pp_study) register I32 *sfirst; register I32 *snext; I32 retval; + STRLEN len; - s = (unsigned char*)(SvPVn(TARG)); - pos = SvCUROK(TARG); + s = (unsigned char*)(SvPV(TARG, len)); + pos = len; if (lastscream) SvSCREAM_off(lastscream); lastscream = TARG; @@ -1576,7 +1624,8 @@ PP(pp_repeat) SP--; } MARK++; - repeatcpy(MARK + items, MARK, items * sizeof(SV*), count - 1); + repeatcpy((char*)(MARK + items), (char*)MARK, + items * sizeof(SV*), count - 1); } SP += max; } @@ -1585,17 +1634,21 @@ PP(pp_repeat) char *tmps; tmpstr = POPs; + if (SvREADONLY(tmpstr)) + DIE("Can't x= to readonly value"); SvSetSV(TARG, tmpstr); if (count >= 1) { + STRLEN len; + STRLEN tlen; tmpstr = NEWSV(50, 0); - tmps = SvPVn(TARG); - sv_setpvn(tmpstr, tmps, SvCUR(TARG)); - tmps = SvPVn(tmpstr); /* force to be string */ - SvGROW(TARG, (count * SvCUR(TARG)) + 1); - repeatcpy(SvPV(TARG), tmps, SvCUR(tmpstr), count); + tmps = SvPV(TARG, len); + sv_setpvn(tmpstr, tmps, len); + tmps = SvPV(tmpstr, tlen); /* force to be string */ + SvGROW(TARG, (count * len) + 1); + repeatcpy((char*)SvPVX(TARG), tmps, tlen, count); SvCUR(TARG) *= count; *SvEND(TARG) = '\0'; - SvNOK_off(TARG); + SvPOK_only(TARG); sv_free(tmpstr); } else @@ -1764,8 +1817,8 @@ PP(pp_bit_and) { dSP; dATARGET; dPOPTOPssrl; if (SvNIOK(lstr) || SvNIOK(rstr)) { - I32 value = SvIVn(lstr); - value = value & SvIVn(rstr); + I32 value = SvIV(lstr); + value = value & SvIV(rstr); SETi(value); } else { @@ -1779,8 +1832,8 @@ PP(pp_xor) { dSP; dATARGET; dPOPTOPssrl; if (SvNIOK(lstr) || SvNIOK(rstr)) { - I32 value = SvIVn(lstr); - value = value ^ SvIVn(rstr); + I32 value = SvIV(lstr); + value = value ^ SvIV(rstr); SETi(value); } else { @@ -1794,8 +1847,8 @@ PP(pp_bit_or) { dSP; dATARGET; dPOPTOPssrl; if (SvNIOK(lstr) || SvNIOK(rstr)) { - I32 value = SvIVn(lstr); - value = value | SvIVn(rstr); + I32 value = SvIV(lstr); + value = value | SvIV(rstr); SETi(value); } else { @@ -1824,15 +1877,16 @@ PP(pp_complement) register I32 anum; if (SvNIOK(sv)) { - SETi( ~SvIVn(sv) ); + SETi( ~SvIV(sv) ); } else { register char *tmps; register long *tmpl; + STRLEN len; SvSetSV(TARG, sv); - tmps = SvPVn(TARG); - anum = SvCUR(TARG); + tmps = SvPV(TARG, len); + anum = len; #ifdef LIBERAL for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++) *tmps = ~*tmps; @@ -1863,7 +1917,7 @@ PP(pp_sin) dSP; dTARGET; double value; if (MAXARG < 1) - value = SvNVnx(GvSV(defgv)); + value = SvNVx(GvSV(defgv)); else value = POPn; value = sin(value); @@ -1876,7 +1930,7 @@ PP(pp_cos) dSP; dTARGET; double value; if (MAXARG < 1) - value = SvNVnx(GvSV(defgv)); + value = SvNVx(GvSV(defgv)); else value = POPn; value = cos(value); @@ -1933,7 +1987,7 @@ PP(pp_exp) dSP; dTARGET; double value; if (MAXARG < 1) - value = SvNVnx(GvSV(defgv)); + value = SvNVx(GvSV(defgv)); else value = POPn; value = exp(value); @@ -1946,7 +2000,7 @@ PP(pp_log) dSP; dTARGET; double value; if (MAXARG < 1) - value = SvNVnx(GvSV(defgv)); + value = SvNVx(GvSV(defgv)); else value = POPn; if (value <= 0.0) @@ -1961,7 +2015,7 @@ PP(pp_sqrt) dSP; dTARGET; double value; if (MAXARG < 1) - value = SvNVnx(GvSV(defgv)); + value = SvNVx(GvSV(defgv)); else value = POPn; if (value < 0.0) @@ -1976,7 +2030,7 @@ PP(pp_int) dSP; dTARGET; double value; if (MAXARG < 1) - value = SvNVnx(GvSV(defgv)); + value = SvNVx(GvSV(defgv)); else value = POPn; if (value >= 0.0) @@ -1989,6 +2043,22 @@ PP(pp_int) RETURN; } +PP(pp_abs) +{ + dSP; dTARGET; + double value; + if (MAXARG < 1) + value = SvNVx(GvSV(defgv)); + else + value = POPn; + + if (value < 0.0) + value = -value; + + XPUSHn(value); + RETURN; +} + PP(pp_hex) { dSP; dTARGET; @@ -1996,7 +2066,7 @@ PP(pp_hex) I32 argtype; if (MAXARG < 1) - tmps = SvPVnx(GvSV(defgv)); + tmps = SvPVx(GvSV(defgv), na); else tmps = POPp; XPUSHi( scan_hex(tmps, 99, &argtype) ); @@ -2011,7 +2081,7 @@ PP(pp_oct) char *tmps; if (MAXARG < 1) - tmps = SvPVnx(GvSV(defgv)); + tmps = SvPVx(GvSV(defgv), na); else tmps = POPp; while (*tmps && (isSPACE(*tmps) || *tmps == '0')) @@ -2042,7 +2112,7 @@ PP(pp_substr) dSP; dTARGET; SV *sv; I32 len; - I32 curlen; + STRLEN curlen; I32 pos; I32 rem; I32 lvalue = op->op_flags & OPf_LVAL; @@ -2052,8 +2122,7 @@ PP(pp_substr) len = POPi; pos = POPi - arybase; sv = POPs; - tmps = SvPVn(sv); /* force conversion to string */ - curlen = SvCUROK(sv); + tmps = SvPV(sv, curlen); /* force conversion to string */ if (pos < 0) pos += curlen + arybase; if (pos < 0 || pos > curlen) @@ -2069,9 +2138,11 @@ PP(pp_substr) rem = len; sv_setpvn(TARG, tmps, rem); if (lvalue) { /* it's an lvalue! */ + if (SvREADONLY(sv)) + DIE(no_modify); LvTYPE(TARG) = 's'; LvTARG(TARG) = sv; - LvTARGOFF(TARG) = tmps - SvPVn(sv); + LvTARGOFF(TARG) = tmps - SvPV(sv, na); LvTARGLEN(TARG) = rem; } } @@ -2086,10 +2157,10 @@ PP(pp_vec) register I32 offset = POPi; register SV *src = POPs; I32 lvalue = op->op_flags & OPf_LVAL; - unsigned char *s = (unsigned char*)SvPVn(src); + STRLEN srclen; + unsigned char *s = (unsigned char*)SvPV(src, srclen); unsigned long retnum; I32 len; - I32 srclen = SvCUROK(src); offset *= size; /* turn into bit offset */ len = (offset + size + 7) / 8; @@ -2100,10 +2171,10 @@ PP(pp_vec) else { if (len > srclen) { SvGROW(src, len); - (void)memzero(SvPV(src) + srclen, len - srclen); + (void)memzero(SvPVX(src) + srclen, len - srclen); SvCUR_set(src, len); } - s = (unsigned char*)SvPVn(src); + s = (unsigned char*)SvPV(src, na); if (size < 8) retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1); else { @@ -2119,6 +2190,8 @@ PP(pp_vec) } if (lvalue) { /* it's an lvalue! */ + if (SvREADONLY(src)) + DIE(no_modify); LvTYPE(TARG) = 'v'; LvTARG(TARG) = src; LvTARGOFF(TARG) = offset; @@ -2140,7 +2213,7 @@ PP(pp_index) I32 retval; char *tmps; char *tmps2; - I32 biglen; + STRLEN biglen; if (MAXARG < 3) offset = 0; @@ -2148,8 +2221,7 @@ PP(pp_index) offset = POPi - arybase; little = POPs; big = POPs; - tmps = SvPVn(big); - biglen = SvCUROK(big); + tmps = SvPV(big, biglen); if (offset < 0) offset = 0; else if (offset > biglen) @@ -2168,6 +2240,8 @@ PP(pp_rindex) dSP; dTARGET; SV *big; SV *little; + STRLEN blen; + STRLEN llen; SV *offstr; I32 offset; I32 retval; @@ -2178,18 +2252,18 @@ PP(pp_rindex) offstr = POPs; little = POPs; big = POPs; - tmps2 = SvPVn(little); - tmps = SvPVn(big); + tmps2 = SvPV(little, llen); + tmps = SvPV(big, blen); if (MAXARG < 3) - offset = SvCUROK(big); + offset = blen; else - offset = SvIVn(offstr) - arybase + SvCUROK(little); + offset = SvIV(offstr) - arybase + llen; if (offset < 0) offset = 0; - else if (offset > SvCUROK(big)) - offset = SvCUROK(big); + else if (offset > blen) + offset = blen; if (!(tmps2 = rninstr(tmps, tmps + offset, - tmps2, tmps2 + SvCUROK(little)))) + tmps2, tmps2 + llen))) retval = -1 + arybase; else retval = tmps2 - tmps + arybase; @@ -2210,8 +2284,9 @@ static void doparseform(sv) SV *sv; { - register char *s = SvPVn(sv); - register char *send = s + SvCUR(sv); + STRLEN len; + register char *s = SvPV(sv, len); + register char *send = s + len; register char *base; register I32 skipspaces = 0; bool noblank; @@ -2372,7 +2447,7 @@ SV *sv; arg = fpc - fops; SvGROW(sv, SvCUR(sv) + arg * sizeof(U16) + 4); - s = SvPV(sv) + SvCUR(sv); + s = SvPVX(sv) + SvCUR(sv); s += 2 + (SvCUR(sv) & 1); Copy(fops, s, arg, U16); @@ -2400,17 +2475,19 @@ PP(pp_formline) SV **markmark; double value; bool gotsome; + STRLEN len; if (!SvCOMPILED(form)) doparseform(form); + SvUPGRADE(formtarget, SVt_PV); SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1); - t = SvPVn(formtarget); - t += SvCUR(formtarget); - f = SvPVn(form); + t = SvPV(formtarget, len); + t += len; + f = SvPV(form, len); - s = f + SvCUR(form); - s += 2 + (SvCUR(form) & 1); + s = f + len; + s += 2 + (len & 1); fpc = (U16*)s; @@ -2476,8 +2553,8 @@ PP(pp_formline) break; case FF_CHECKNL: - s = SvPVn(sv); - itemsize = SvCUROK(sv); + s = SvPV(sv, len); + itemsize = len; if (itemsize > fieldsize) itemsize = fieldsize; send = chophere = s + itemsize; @@ -2488,12 +2565,12 @@ PP(pp_formline) break; s++; } - itemsize = s - SvPV(sv); + itemsize = s - SvPVX(sv); break; case FF_CHECKCHOP: - s = SvPVn(sv); - itemsize = SvCUROK(sv); + s = SvPV(sv, len); + itemsize = len; if (itemsize > fieldsize) itemsize = fieldsize; send = chophere = s + itemsize; @@ -2512,7 +2589,7 @@ PP(pp_formline) } s++; } - itemsize = chophere - SvPV(sv); + itemsize = chophere - SvPVX(sv); break; case FF_SPACE: @@ -2536,7 +2613,7 @@ PP(pp_formline) case FF_ITEM: arg = itemsize; - s = SvPV(sv); + s = SvPVX(sv); while (arg--) { if ((*t++ = *s++) < ' ') t[-1] = ' '; @@ -2553,8 +2630,8 @@ PP(pp_formline) break; case FF_LINEGLOB: - s = SvPVn(sv); - itemsize = SvCUROK(sv); + s = SvPV(sv, len); + itemsize = len; if (itemsize) { gotsome = TRUE; send = s + itemsize; @@ -2566,10 +2643,10 @@ PP(pp_formline) lines++; } } - SvCUR_set(formtarget, t - SvPV(formtarget)); - sv_catpvn(formtarget, SvPV(sv), itemsize); + SvCUR_set(formtarget, t - SvPVX(formtarget)); + sv_catpvn(formtarget, SvPVX(sv), itemsize); SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1); - t = SvPV(formtarget) + SvCUR(formtarget); + t = SvPVX(formtarget) + SvCUR(formtarget); } break; @@ -2584,7 +2661,7 @@ PP(pp_formline) break; } gotsome = TRUE; - value = SvNVn(sv); + value = SvNV(sv); if (arg & 256) { sprintf(t, "%#*.*f", fieldsize, arg & 255, value); } else { @@ -2612,10 +2689,10 @@ PP(pp_formline) if (strnEQ(linemark, linemark - t, arg)) DIE("Runaway format"); } - arg = t - SvPV(formtarget); + arg = t - SvPVX(formtarget); SvGROW(formtarget, - (t - SvPV(formtarget)) + (f - formmark) + 1); - t = SvPV(formtarget) + arg; + (t - SvPVX(formtarget)) + (f - formmark) + 1); + t = SvPVX(formtarget) + arg; } } else { @@ -2634,7 +2711,7 @@ PP(pp_formline) } s = t - 3; if (strnEQ(s," ",3)) { - while (s > SvPV(formtarget) && isSPACE(s[-1])) + while (s > SvPVX(formtarget) && isSPACE(s[-1])) s--; } *s++ = '.'; @@ -2645,7 +2722,7 @@ PP(pp_formline) case FF_END: *t = '\0'; - SvCUR_set(formtarget, t - SvPV(formtarget)); + SvCUR_set(formtarget, t - SvPVX(formtarget)); FmLINES(formtarget) += lines; SP = ORIGMARK; RETPUSHYES; @@ -2661,7 +2738,7 @@ PP(pp_ord) I32 anum; if (MAXARG < 1) - tmps = SvPVnx(GvSV(defgv)); + tmps = SvPVx(GvSV(defgv), na); else tmps = POPp; #ifndef I286 @@ -2674,15 +2751,35 @@ PP(pp_ord) RETURN; } +PP(pp_chr) +{ + dSP; dTARGET; + char *tmps; + + if (SvTYPE(TARG) == SVt_NULL) { + sv_upgrade(TARG,SVt_PV); + SvGROW(TARG,1); + } + SvCUR_set(TARG, 1); + tmps = SvPVX(TARG); + if (MAXARG < 1) + *tmps = SvIVx(GvSV(defgv)); + else + *tmps = POPi; + SvPOK_only(TARG); + XPUSHs(TARG); + RETURN; +} + PP(pp_crypt) { dSP; dTARGET; dPOPTOPssrl; #ifdef HAS_CRYPT - char *tmps = SvPVn(lstr); + char *tmps = SvPV(lstr, na); #ifdef FCRYPT - sv_setpv(TARG, fcrypt(tmps, SvPVn(rstr))); + sv_setpv(TARG, fcrypt(tmps, SvPV(rstr, na))); #else - sv_setpv(TARG, crypt(tmps, SvPVn(rstr))); + sv_setpv(TARG, crypt(tmps, SvPV(rstr, na))); #endif #else DIE( @@ -2704,7 +2801,7 @@ PP(pp_ucfirst) sv = TARG; SETs(sv); } - s = SvPVn(sv); + s = SvPV(sv, na); if (isascii(*s) && islower(*s)) *s = toupper(*s); @@ -2723,7 +2820,7 @@ PP(pp_lcfirst) sv = TARG; SETs(sv); } - s = SvPVn(sv); + s = SvPV(sv, na); if (isascii(*s) && isupper(*s)) *s = tolower(*s); @@ -2737,6 +2834,7 @@ PP(pp_uc) SV *sv = TOPs; register char *s; register char *send; + STRLEN len; if (SvSTORAGE(sv) != 'T') { dTARGET; @@ -2744,8 +2842,8 @@ PP(pp_uc) sv = TARG; SETs(sv); } - s = SvPVn(sv); - send = s + SvCUROK(sv); + s = SvPV(sv, len); + send = s + len; while (s < send) { if (isascii(*s) && islower(*s)) *s = toupper(*s); @@ -2760,6 +2858,7 @@ PP(pp_lc) SV *sv = TOPs; register char *s; register char *send; + STRLEN len; if (SvSTORAGE(sv) != 'T') { dTARGET; @@ -2767,8 +2866,8 @@ PP(pp_lc) sv = TARG; SETs(sv); } - s = SvPVn(sv); - send = s + SvCUROK(sv); + s = SvPV(sv, len); + send = s + len; while (s < send) { if (isascii(*s) && isupper(*s)) *s = tolower(*s); @@ -2791,7 +2890,7 @@ PP(pp_rv2av) DIE("Not an array reference"); if (op->op_flags & OPf_LVAL) { if (op->op_flags & OPf_INTRO) - av = (AV*)save_svref(sv); + av = (AV*)save_svref((SV**)sv); PUSHs((SV*)av); RETURN; } @@ -2808,7 +2907,7 @@ PP(pp_rv2av) if (SvTYPE(sv) != SVt_PVGV) { if (!SvOK(sv)) DIE(no_usym); - sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE); + sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE); } av = GvAVn(sv); if (op->op_flags & OPf_LVAL) { @@ -2856,14 +2955,18 @@ PP(pp_aelem) DIE(no_aelem, elem); if (op->op_flags & OPf_INTRO) save_svref(svp); - else if (SvTYPE(*svp) == SVt_NULL) { + else if (!SvOK(*svp)) { if (op->op_private == OP_RV2HV) { sv_free(*svp); - *svp = (SV*)newHV(COEFFSIZE); + *svp = NEWSV(0,0); + sv_upgrade(*svp, SVt_REF); + SvANY(*svp) = (void*)sv_ref((SV*)newHV()); } else if (op->op_private == OP_RV2AV) { sv_free(*svp); - *svp = (SV*)newAV(); + *svp = NEWSV(0,0); + sv_upgrade(*svp, SVt_REF); + SvANY(*svp) = (void*)sv_ref((SV*)newAV()); } } } @@ -2882,7 +2985,7 @@ PP(pp_aslice) I32 is_something_there = lval; while (++MARK <= SP) { - I32 elem = SvIVnx(*MARK); + I32 elem = SvIVx(*MARK); if (lval) { svp = av_fetch(av, elem, TRUE); @@ -2953,11 +3056,12 @@ PP(pp_delete) SV *tmpsv = POPs; HV *hv = (HV*)POPs; char *tmps; + STRLEN len; if (!hv) { DIE("Not an associative array reference"); } - tmps = SvPVn(tmpsv); - sv = hv_delete(hv, tmps, SvCUROK(tmpsv)); + tmps = SvPV(tmpsv, len); + sv = hv_delete(hv, tmps, len); if (!sv) RETPUSHUNDEF; PUSHs(sv); @@ -2977,7 +3081,7 @@ PP(pp_rv2hv) DIE("Not an associative array reference"); if (op->op_flags & OPf_LVAL) { if (op->op_flags & OPf_INTRO) - hv = (HV*)save_svref(sv); + hv = (HV*)save_svref((SV**)sv); SETs((SV*)hv); RETURN; } @@ -2994,7 +3098,7 @@ PP(pp_rv2hv) if (SvTYPE(sv) != SVt_PVGV) { if (!SvOK(sv)) DIE(no_usym); - sv = (SV*)gv_fetchpv(SvPVn(sv), TRUE); + sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE); } hv = GvHVn(sv); if (op->op_flags & OPf_LVAL) { @@ -3015,8 +3119,7 @@ PP(pp_rv2hv) if (HvFILL(hv)) sv_setiv(TARG, 0); else { - sprintf(buf, "%d/%d", HvFILL(hv), - HvFILL(hv)+1); + sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1); sv_setpv(TARG, buf); } SETTARG; @@ -3029,8 +3132,8 @@ PP(pp_helem) dSP; SV** svp; SV *keysv = POPs; - char *key = SvPVn(keysv); - I32 keylen = SvCUROK(keysv); + STRLEN keylen; + char *key = SvPV(keysv, keylen); HV *hv = (HV*)POPs; if (op->op_flags & OPf_LVAL) { @@ -3039,14 +3142,18 @@ PP(pp_helem) DIE(no_helem, key); if (op->op_flags & OPf_INTRO) save_svref(svp); - else if (SvTYPE(*svp) == SVt_NULL) { + else if (!SvOK(*svp)) { if (op->op_private == OP_RV2HV) { sv_free(*svp); - *svp = (SV*)newHV(COEFFSIZE); + *svp = NEWSV(0,0); + sv_upgrade(*svp, SVt_REF); + SvANY(*svp) = (void*)sv_ref((SV*)newHV()); } else if (op->op_private == OP_RV2AV) { sv_free(*svp); - *svp = (SV*)newAV(); + *svp = NEWSV(0,0); + sv_upgrade(*svp, SVt_REF); + SvANY(*svp) = (void*)sv_ref((SV*)newAV()); } } } @@ -3065,8 +3172,8 @@ PP(pp_hslice) I32 is_something_there = lval; while (++MARK <= SP) { - char *key = SvPVnx(*MARK); - I32 keylen = SvCUROK(*MARK); + STRLEN keylen; + char *key = SvPV(*MARK, keylen); if (lval) { svp = hv_fetch(hv, key, keylen, TRUE); @@ -3094,11 +3201,13 @@ PP(pp_unpack) dSP; dPOPPOPssrl; SV *sv; - register char *pat = SvPVn(lstr); - register char *s = SvPVn(rstr); - char *strend = s + SvCUROK(rstr); + STRLEN llen; + STRLEN rlen; + register char *pat = SvPV(lstr, llen); + register char *s = SvPV(rstr, rlen); + char *strend = s + rlen; char *strbeg = s; - register char *patend = pat + SvCUROK(lstr); + register char *patend = pat + llen; I32 datumtype; register I32 len; register I32 bits; @@ -3189,11 +3298,11 @@ PP(pp_unpack) s += len; if (datumtype == 'A') { aptr = s; /* borrow register */ - s = SvPV(sv) + len - 1; - while (s >= SvPV(sv) && (!*s || isSPACE(*s))) + s = SvPVX(sv) + len - 1; + while (s >= SvPVX(sv) && (!*s || isSPACE(*s))) s--; *++s = '\0'; - SvCUR_set(sv, s - SvPV(sv)); + SvCUR_set(sv, s - SvPVX(sv)); s = aptr; /* unborrow register */ } XPUSHs(sv_2mortal(sv)); @@ -3241,7 +3350,7 @@ PP(pp_unpack) SvCUR_set(sv, len); SvPOK_on(sv); aptr = pat; /* borrow register */ - pat = SvPV(sv); + pat = SvPVX(sv); if (datumtype == 'b') { aint = len; for (len = 0; len < aint; len++) { @@ -3274,7 +3383,7 @@ PP(pp_unpack) SvCUR_set(sv, len); SvPOK_on(sv); aptr = pat; /* borrow register */ - pat = SvPV(sv); + pat = SvPVX(sv); if (datumtype == 'h') { aint = len; for (len = 0; len < aint; len++) { @@ -3540,6 +3649,19 @@ PP(pp_unpack) PUSHs(sv_2mortal(sv)); } break; + case 'P': + EXTEND(SP, 1); + if (sizeof(char*) > strend - s) + break; + else { + Copy(s, &aptr, 1, char*); + s += sizeof(char*); + } + sv = NEWSV(44, 0); + if (aptr) + sv_setpvn(sv, aptr, len); + PUSHs(sv_2mortal(sv)); + break; #ifdef QUAD case 'q': EXTEND(SP, len); @@ -3715,7 +3837,7 @@ register I32 len; s += 3; len -= 3; } - for (s = SvPV(sv); *s; s++) { + for (s = SvPVX(sv); *s; s++) { if (*s == ' ') *s = '`'; } @@ -3727,14 +3849,14 @@ PP(pp_pack) dSP; dMARK; dORIGMARK; dTARGET; register SV *cat = TARG; register I32 items; - register char *pat = SvPVnx(*++MARK); - register char *patend = pat + SvCUROK(*MARK); + STRLEN fromlen; + register char *pat = SvPVx(*++MARK, fromlen); + register char *patend = pat + fromlen; register I32 len; I32 datumtype; SV *fromstr; - I32 fromlen; /*SUPPRESS 442*/ - static char *null10 = "\0\0\0\0\0\0\0\0\0\0"; + static char null10[] = {0,0,0,0,0,0,0,0,0,0}; static char *space10 = " "; /* These must not be in registers: */ @@ -3800,8 +3922,7 @@ PP(pp_pack) case 'A': case 'a': fromstr = NEXTFROM; - aptr = SvPVn(fromstr); - fromlen = SvCUROK(fromstr); + aptr = SvPV(fromstr, fromlen); if (pat[-1] == '*') len = fromlen; if (fromlen > len) @@ -3833,15 +3954,14 @@ PP(pp_pack) fromstr = NEXTFROM; saveitems = items; - aptr = SvPVn(fromstr); - fromlen = SvCUROK(fromstr); + aptr = SvPV(fromstr, fromlen); if (pat[-1] == '*') len = fromlen; pat = aptr; aint = SvCUR(cat); SvCUR(cat) += (len+7)/8; SvGROW(cat, SvCUR(cat) + 1); - aptr = SvPV(cat) + aint; + aptr = SvPVX(cat) + aint; if (len > fromlen) len = fromlen; aint = len; @@ -3876,7 +3996,7 @@ PP(pp_pack) items >>= 7 - (aint & 7); *aptr++ = items & 0xff; } - pat = SvPV(cat) + SvCUR(cat); + pat = SvPVX(cat) + SvCUR(cat); while (aptr <= pat) *aptr++ = '\0'; @@ -3892,15 +4012,14 @@ PP(pp_pack) fromstr = NEXTFROM; saveitems = items; - aptr = SvPVn(fromstr); - fromlen = SvCUROK(fromstr); + aptr = SvPV(fromstr, fromlen); if (pat[-1] == '*') len = fromlen; pat = aptr; aint = SvCUR(cat); SvCUR(cat) += (len+1)/2; SvGROW(cat, SvCUR(cat) + 1); - aptr = SvPV(cat) + aint; + aptr = SvPVX(cat) + aint; if (len > fromlen) len = fromlen; aint = len; @@ -3935,7 +4054,7 @@ PP(pp_pack) } if (aint & 1) *aptr++ = items & 0xff; - pat = SvPV(cat) + SvCUR(cat); + pat = SvPVX(cat) + SvCUR(cat); while (aptr <= pat) *aptr++ = '\0'; @@ -3947,7 +4066,7 @@ PP(pp_pack) case 'c': while (len-- > 0) { fromstr = NEXTFROM; - aint = SvIVn(fromstr); + aint = SvIV(fromstr); achar = aint; sv_catpvn(cat, &achar, sizeof(char)); } @@ -3957,7 +4076,7 @@ PP(pp_pack) case 'F': while (len-- > 0) { fromstr = NEXTFROM; - afloat = (float)SvNVn(fromstr); + afloat = (float)SvNV(fromstr); sv_catpvn(cat, (char *)&afloat, sizeof (float)); } break; @@ -3965,14 +4084,14 @@ PP(pp_pack) case 'D': while (len-- > 0) { fromstr = NEXTFROM; - adouble = (double)SvNVn(fromstr); + adouble = (double)SvNV(fromstr); sv_catpvn(cat, (char *)&adouble, sizeof (double)); } break; case 'n': while (len-- > 0) { fromstr = NEXTFROM; - ashort = (I16)SvIVn(fromstr); + ashort = (I16)SvIV(fromstr); #ifdef HAS_HTONS ashort = htons(ashort); #endif @@ -3982,7 +4101,7 @@ PP(pp_pack) case 'v': while (len-- > 0) { fromstr = NEXTFROM; - ashort = (I16)SvIVn(fromstr); + ashort = (I16)SvIV(fromstr); #ifdef HAS_HTOVS ashort = htovs(ashort); #endif @@ -3993,28 +4112,28 @@ PP(pp_pack) case 's': while (len-- > 0) { fromstr = NEXTFROM; - ashort = (I16)SvIVn(fromstr); + ashort = (I16)SvIV(fromstr); sv_catpvn(cat, (char*)&ashort, sizeof(I16)); } break; case 'I': while (len-- > 0) { fromstr = NEXTFROM; - auint = U_I(SvNVn(fromstr)); + auint = U_I(SvNV(fromstr)); sv_catpvn(cat, (char*)&auint, sizeof(unsigned int)); } break; case 'i': while (len-- > 0) { fromstr = NEXTFROM; - aint = SvIVn(fromstr); + aint = SvIV(fromstr); sv_catpvn(cat, (char*)&aint, sizeof(int)); } break; case 'N': while (len-- > 0) { fromstr = NEXTFROM; - aulong = U_L(SvNVn(fromstr)); + aulong = U_L(SvNV(fromstr)); #ifdef HAS_HTONL aulong = htonl(aulong); #endif @@ -4024,7 +4143,7 @@ PP(pp_pack) case 'V': while (len-- > 0) { fromstr = NEXTFROM; - aulong = U_L(SvNVn(fromstr)); + aulong = U_L(SvNV(fromstr)); #ifdef HAS_HTOVL aulong = htovl(aulong); #endif @@ -4034,14 +4153,14 @@ PP(pp_pack) case 'L': while (len-- > 0) { fromstr = NEXTFROM; - aulong = U_L(SvNVn(fromstr)); + aulong = U_L(SvNV(fromstr)); sv_catpvn(cat, (char*)&aulong, sizeof(U32)); } break; case 'l': while (len-- > 0) { fromstr = NEXTFROM; - along = SvIVn(fromstr); + along = SvIV(fromstr); sv_catpvn(cat, (char*)&along, sizeof(I32)); } break; @@ -4049,29 +4168,31 @@ PP(pp_pack) case 'Q': while (len-- > 0) { fromstr = NEXTFROM; - auquad = (unsigned quad)SvNVn(fromstr); + auquad = (unsigned quad)SvNV(fromstr); sv_catpvn(cat, (char*)&auquad, sizeof(unsigned quad)); } break; case 'q': while (len-- > 0) { fromstr = NEXTFROM; - aquad = (quad)SvNVn(fromstr); + aquad = (quad)SvNV(fromstr); sv_catpvn(cat, (char*)&aquad, sizeof(quad)); } break; #endif /* QUAD */ + case 'P': + len = 1; /* assume SV is correct length */ + /* FALL THROUGH */ case 'p': while (len-- > 0) { fromstr = NEXTFROM; - aptr = SvPVn(fromstr); + aptr = SvPV(fromstr, na); sv_catpvn(cat, (char*)&aptr, sizeof(char*)); } break; case 'u': fromstr = NEXTFROM; - aptr = SvPVn(fromstr); - fromlen = SvCUROK(fromstr); + aptr = SvPV(fromstr, fromlen); SvGROW(cat, fromlen * 4 / 3); if (len <= 1) len = 45; @@ -4104,8 +4225,9 @@ PP(pp_split) AV *ary; register I32 limit = POPi; /* note, negative is forever */ SV *sv = POPs; - register char *s = SvPVn(sv); - char *strend = s + SvCUROK(sv); + STRLEN len; + register char *s = SvPV(sv, len); + char *strend = s + len; register PMOP *pm = (PMOP*)POPs; register SV *dstr; register char *m; @@ -4181,7 +4303,7 @@ PP(pp_split) i = SvCUR(pm->op_pmshort); if (i == 1) { I32 fold = (pm->op_pmflags & PMf_FOLD); - i = *SvPV(pm->op_pmshort); + i = *SvPVX(pm->op_pmshort); if (fold && isUPPER(i)) i = tolower(i); while (--limit) { @@ -4327,7 +4449,7 @@ PP(pp_lslice) register I32 ix; if (GIMME != G_ARRAY) { - ix = SvIVnx(*lastlelem) - arybase; + ix = SvIVx(*lastlelem) - arybase; if (ix < 0 || ix >= max) *firstlelem = &sv_undef; else @@ -4337,12 +4459,12 @@ PP(pp_lslice) } if (max == 0) { - SP = firstlelem; + SP = firstlelem - 1; RETURN; } for (lelem = firstlelem; lelem <= lastlelem; lelem++) { - ix = SvIVnx(*lelem) - arybase; + ix = SvIVx(*lelem) - arybase; if (ix < 0 || ix >= max || !(*lelem = firstrelem[ix])) *lelem = &sv_undef; if (!is_something_there && SvOK(*lelem)) @@ -4351,7 +4473,7 @@ PP(pp_lslice) if (is_something_there) SP = lastlelem; else - SP = firstlelem; + SP = firstlelem - 1; RETURN; } @@ -4367,7 +4489,7 @@ PP(pp_anonlist) PP(pp_anonhash) { dSP; dMARK; dORIGMARK; - HV* hv = newHV(COEFFSIZE); + HV* hv = newHV(); SvREFCNT(hv) = 0; while (MARK < SP) { SV* key = *++MARK; @@ -4375,7 +4497,7 @@ PP(pp_anonhash) SV *val = NEWSV(46, 0); if (MARK < SP) sv_setsv(val, *++MARK); - tmps = SvPV(key); + tmps = SvPVX(key); (void)hv_store(hv,tmps,SvCUROK(key),val,0); } SP = ORIGMARK; @@ -4400,13 +4522,13 @@ PP(pp_splice) SP++; if (++MARK < SP) { - offset = SvIVnx(*MARK); + offset = SvIVx(*MARK); if (offset < 0) offset += AvFILL(ary) + 1; else offset -= arybase; if (++MARK < SP) { - length = SvIVnx(*MARK++); + length = SvIVx(*MARK++); if (length < 0) length = 0; } @@ -4706,6 +4828,9 @@ PP(pp_grepwhile) } } +static int sortcmp(); +static int sortcv(); + PP(pp_sort) { dSP; dMARK; dORIGMARK; @@ -4713,8 +4838,6 @@ PP(pp_sort) SV **myorigmark = ORIGMARK; register I32 max; register I32 i; - int sortcmp(); - int sortcv(); HV *stash; SV *sortcvvar; GV *gv; @@ -4740,9 +4863,9 @@ PP(pp_sort) SV *tmpstr = sv_mortalcopy(&sv_undef); gv_efullname(tmpstr, gv); if (CvUSERSUB(cv)) - DIE("Usersub \"%s\" called in sort", SvPV(tmpstr)); + DIE("Usersub \"%s\" called in sort", SvPVX(tmpstr)); DIE("Undefined sort subroutine \"%s\" called", - SvPV(tmpstr)); + SvPVX(tmpstr)); } if (cv) { if (CvUSERSUB(cv)) @@ -4766,7 +4889,7 @@ PP(pp_sort) /*SUPPRESS 560*/ if (*up = *++MARK) { /* Weed out nulls. */ if (!SvPOK(*up)) - (void)sv_2pv(*up); + (void)sv_2pv(*up, &na); else SvTEMP_off(*up); up++; @@ -4833,14 +4956,15 @@ PP(pp_reverse) register char *down; register I32 tmp; dTARGET; + STRLEN len; if (SP - MARK > 1) do_join(TARG, &sv_no, MARK, SP); else sv_setsv(TARG, *SP); - up = SvPVn(TARG); - if (SvCUROK(TARG) > 1) { - down = SvPV(TARG) + SvCUR(TARG) - 1; + up = SvPV(TARG, len); + if (len > 1) { + down = SvPVX(TARG) + len - 1; while (down > up) { tmp = *up; *up++ = *down; @@ -4875,7 +4999,7 @@ PP(pp_flip) SV *targ = PAD_SV(op->op_targ); if ((op->op_private & OPpFLIP_LINENUM) - ? last_in_gv && SvIVn(sv) == GvIO(last_in_gv)->lines + ? last_in_gv && SvIV(sv) == GvIO(last_in_gv)->lines : SvTRUE(sv) ) { sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1); if (op->op_flags & OPf_SPECIAL) { @@ -4905,9 +5029,9 @@ PP(pp_flop) I32 max; if (SvNIOK(lstr) || !SvPOK(lstr) || - (looks_like_number(lstr) && *SvPV(lstr) != '0') ) { - i = SvIVn(lstr); - max = SvIVn(rstr); + (looks_like_number(lstr) && *SvPVX(lstr) != '0') ) { + i = SvIV(lstr); + max = SvIV(rstr); if (max > i) EXTEND(SP, max - i + 1); while (i <= max) { @@ -4918,16 +5042,17 @@ PP(pp_flop) } else { SV *final = sv_mortalcopy(rstr); - char *tmps = SvPVn(final); + STRLEN len; + char *tmps = SvPV(final, len); sv = sv_mortalcopy(lstr); - while (!SvNIOK(sv) && SvCUR(sv) <= SvCUR(final) && - strNE(SvPV(sv),tmps) ) { + while (!SvNIOK(sv) && SvCUR(sv) <= len && + strNE(SvPVX(sv),tmps) ) { XPUSHs(sv); sv = sv_2mortal(newSVsv(sv)); sv_inc(sv); } - if (strEQ(SvPV(sv),tmps)) + if (strEQ(SvPVX(sv),tmps)) XPUSHs(sv); } } @@ -4936,7 +5061,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 && SvIVn(sv) == GvIO(last_in_gv)->lines + ? last_in_gv && SvIV(sv) == GvIO(last_in_gv)->lines : SvTRUE(sv) ) { sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0); sv_catpv(targ, "E0"); @@ -5083,8 +5208,12 @@ I32 cxix; /*VARARGS0*/ OP * +#ifdef __STDC__ +die(char* pat,...) +#else die(va_alist) va_dcl +#endif { va_list args; char *tmps; @@ -5131,7 +5260,7 @@ char *message; LEAVE; if (optype == OP_REQUIRE) - DIE("%s", SvPVnx(GvSV(gv_fetchpv("@",TRUE)))); + DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE)), na)); return pop_return(); } } @@ -5195,32 +5324,65 @@ PP(pp_orassign) PP(pp_method) { - dSP; dPOPss; dTARGET; + dSP; dPOPss; SV* ob; GV* gv; - if (SvTYPE(sv) != SVt_REF || !(ob = (SV*)SvANY(sv)) || SvSTORAGE(ob) != 'O') - DIE("Not an object reference"); + EXTEND(sp,2); - if (TARG && SvTYPE(TARG) == SVt_REF) { - /* XXX */ - gv = 0; + gv = 0; + if (SvTYPE(sv) != SVt_REF) { + GV* iogv; + IO* io; + + if (!SvOK(sv) || + !(iogv = gv_fetchpv(SvPVX(sv), FALSE)) || + !(io=GvIO(iogv))) + { + char *name = SvPVX(((SVOP*)cLOGOP->op_other)->op_sv); + char tmpbuf[256]; + char* packname = SvPVX(sv); + HV *stash; + if (!isALPHA(*packname)) +DIE("Can't call method \"%s\" without a package or object reference", name); + if (!(stash = fetch_stash(sv, FALSE))) + DIE("Can't call method \"%s\" in empty package \"%s\"", + name, packname); + gv = gv_fetchmethod(stash,name); + if (!gv) + DIE("Can't locate object method \"%s\" via package \"%s\"", + name, packname); + PUSHs(gv); + PUSHs(sv); + RETURN; + } + if (!(ob = io->object)) { + ob = sv_ref((SV*)newHV()); + SvSTORAGE(ob) = 'O'; + SvUPGRADE(ob, SVt_PVMG); + iogv = gv_fetchpv("FILEHANDLE'flush", TRUE); + SvSTASH(ob) = GvSTASH(iogv); + io->object = ob; + } } - else + else { gv = 0; + ob = (SV*)SvANY(sv); + } + + if (!ob || SvSTORAGE(ob) != 'O') { + char *name = SvPVX(((SVOP*)cLOGOP->op_other)->op_sv); + DIE("Can't call method \"%s\" on unblessed reference", name); + } if (!gv) { /* nothing cached */ - char *name = SvPV(((SVOP*)cLOGOP->op_other)->op_sv); - if (strchr(name, '\'')) - gv = gv_fetchpv(name, FALSE); - else - gv = gv_fetchmethod(SvSTASH(ob),name); + char *name = SvPVX(((SVOP*)cLOGOP->op_other)->op_sv); + gv = gv_fetchmethod(SvSTASH(ob),name); if (!gv) DIE("Can't locate object method \"%s\" via package \"%s\"", name, HvNAME(SvSTASH(ob))); } - EXTEND(sp,2); PUSHs(gv); PUSHs(sv); RETURN; @@ -5244,7 +5406,7 @@ PP(pp_entersubr) if (gv) { SV *tmpstr = sv_mortalcopy(&sv_undef); gv_efullname(tmpstr, gv); - DIE("Undefined subroutine \"%s\" called",SvPV(tmpstr)); + DIE("Undefined subroutine \"%s\" called",SvPVX(tmpstr)); } if (cv) DIE("Undefined subroutine called"); @@ -5260,13 +5422,9 @@ PP(pp_entersubr) } if (CvUSERSUB(cv)) { - cx->blk_sub.hasargs = 0; - cx->blk_sub.savearray = Null(AV*);; - cx->blk_sub.argarray = Null(AV*); - if (!hasargs) - items = 0; - items = (*CvUSERSUB(cv))(CvUSERINDEX(cv), sp - stack_base, items); + items = (*CvUSERSUB(cv))(CvUSERINDEX(cv), MARK - stack_base, items); sp = stack_base + items; + LEAVE; RETURN; } else { @@ -5291,11 +5449,11 @@ PP(pp_entersubr) svp = AvARRAY(svp[0]); while (ix > 0) { if (svp[ix]) { - char *name = SvPV(svp[ix]); /* XXX */ + char *name = SvPVX(svp[ix]); /* XXX */ if (*name == '@') - av_store(newpad, ix--, newAV()); + av_store(newpad, ix--, (SV*)newAV()); else if (*name == '%') - av_store(newpad, ix--, newHV(COEFFSIZE)); + av_store(newpad, ix--, (SV*)newHV()); else av_store(newpad, ix--, NEWSV(0,0)); } @@ -5391,7 +5549,7 @@ PP(pp_caller) } PUSHs(sv_2mortal(newSVpv(HvNAME(cx->blk_oldcop->cop_stash), 0))); - PUSHs(sv_2mortal(newSVpv(SvPV(GvSV(cx->blk_oldcop->cop_filegv)), 0))); + PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0))); PUSHs(sv_2mortal(newSVnv((double)cx->blk_oldcop->cop_line))); if (!MAXARG) RETURN; @@ -5418,12 +5576,18 @@ sortcv(str1, str2) SV **str1; SV **str2; { + I32 oldscopeix = scopestack_ix; + I32 result; GvSV(firstgv) = *str1; GvSV(secondgv) = *str2; stack_sp = stack_base; op = sortcop; run(); - return SvIVnx(AvARRAY(stack)[1]); + result = SvIVx(AvARRAY(stack)[1]); + while (scopestack_ix > oldscopeix) { + LEAVE; + } + return result; } static I32 @@ -5437,13 +5601,13 @@ SV **strp2; if (SvCUR(str1) < SvCUR(str2)) { /*SUPPRESS 560*/ - if (retval = memcmp(SvPV(str1), SvPV(str2), SvCUR(str1))) + if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str1))) return retval; else return -1; } /*SUPPRESS 560*/ - else if (retval = memcmp(SvPV(str1), SvPV(str2), SvCUR(str2))) + else if (retval = memcmp(SvPVX(str1), SvPVX(str2), SvCUR(str2))) return retval; else if (SvCUR(str1) == SvCUR(str2)) return 0; @@ -5458,18 +5622,18 @@ PP(pp_warn) if (SP - MARK != 1) { dTARGET; do_join(TARG, &sv_no, MARK, SP); - tmps = SvPVn(TARG); + tmps = SvPV(TARG, na); SP = MARK + 1; } else { - tmps = SvPVn(TOPs); + tmps = SvPV(TOPs, na); } if (!tmps || !*tmps) { SV *error = GvSV(gv_fetchpv("@", TRUE)); SvUPGRADE(error, SVt_PV); - if (SvCUR(error)) + if (SvPOK(error) && SvCUR(error)) sv_catpv(error, "\t...caught"); - tmps = SvPVn(error); + tmps = SvPV(error, na); } if (!tmps || !*tmps) tmps = "Warning: something's wrong"; @@ -5484,18 +5648,18 @@ PP(pp_die) if (SP - MARK != 1) { dTARGET; do_join(TARG, &sv_no, MARK, SP); - tmps = SvPVn(TARG); + tmps = SvPV(TARG, na); SP = MARK + 1; } else { - tmps = SvPVn(TOPs); + tmps = SvPV(TOPs, na); } if (!tmps || !*tmps) { SV *error = GvSV(gv_fetchpv("@", TRUE)); SvUPGRADE(error, SVt_PV); - if (SvCUR(error)) + if (SvPOK(error) && SvCUR(error)) sv_catpv(error, "\t...propagated"); - tmps = SvPVn(error); + tmps = SvPV(error, na); } if (!tmps || !*tmps) tmps = "Died"; @@ -5525,9 +5689,7 @@ PP(pp_lineseq) PP(pp_nextstate) { curcop = (COP*)op; -#ifdef TAINT - tainted = 0; /* Each statement is presumed innocent */ -#endif + TAINT_NOT; /* Each statement is presumed innocent */ stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; free_tmps(); return NORMAL; @@ -5536,13 +5698,11 @@ PP(pp_nextstate) PP(pp_dbstate) { curcop = (COP*)op; -#ifdef TAINT - tainted = 0; /* Each statement is presumed innocent */ -#endif + TAINT_NOT; /* Each statement is presumed innocent */ stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; free_tmps(); - if (op->op_private || SvIVn(DBsingle) || SvIVn(DBsignal) || SvIVn(DBtrace)) + if (op->op_private || SvIV(DBsingle) || SvIV(DBsignal) || SvIV(DBtrace)) { SV **sp; register CV *cv; @@ -5580,15 +5740,9 @@ PP(pp_dbstate) PP(pp_unstack) { I32 oldsave; -#ifdef TAINT - tainted = 0; /* Each statement is presumed innocent */ -#endif + TAINT_NOT; /* Each statement is presumed innocent */ stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp; - /* XXX should tmps_floor live in cxstack? */ - while (tmps_ix > tmps_floor) { /* clean up after last eval */ - sv_free(tmps_stack[tmps_ix]); - tmps_stack[tmps_ix--] = Nullsv; - } + free_tmps(); oldsave = scopestack[scopestack_ix - 1]; if (savestack_ix > oldsave) leave_scope(oldsave); @@ -5621,6 +5775,11 @@ PP(pp_leave) RETURN; } +PP(pp_scope) +{ + return NORMAL; +} + PP(pp_enteriter) { dSP; dMARK; @@ -5713,6 +5872,11 @@ PP(pp_return) SV **newsp; I32 optype = 0; + if (stack == sortstack) { + AvARRAY(stack)[1] = *SP; + return 0; + } + cxix = dopoptosub(cxstack_ix); if (cxix < 0) DIE("Can't return outside a subroutine"); @@ -5738,11 +5902,11 @@ PP(pp_return) else *++newsp = &sv_undef; if (optype == OP_REQUIRE && !SvTRUE(*newsp)) - DIE("%s", SvPVnx(GvSV(gv_fetchpv("@",TRUE)))); + DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE)), na)); } else { if (optype == OP_REQUIRE && MARK == SP) - DIE("%s", SvPVnx(GvSV(gv_fetchpv("@",TRUE)))); + DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE)), na)); while (MARK < SP) *++newsp = sv_mortalcopy(*++MARK); } @@ -5879,6 +6043,7 @@ OP **opstack; OP **ops = opstack; if (op->op_type == OP_LEAVE || + op->op_type == OP_SCOPE || op->op_type == OP_LEAVELOOP || op->op_type == OP_LEAVETRY) *ops++ = cUNOP->op_first; @@ -6020,7 +6185,7 @@ PP(pp_exit) if (MAXARG < 1) anum = 0; else - anum = SvIVnx(POPs); + anum = SvIVx(POPs); my_exit(anum); PUSHs(&sv_undef); RETURN; @@ -6029,7 +6194,7 @@ PP(pp_exit) PP(pp_nswitch) { dSP; - double value = SvNVnx(GvSV(cCOP->cop_gv)); + double value = SvNVx(GvSV(cCOP->cop_gv)); register I32 match = (I32)value; if (value < 0.0) { @@ -6053,7 +6218,7 @@ PP(pp_cswitch) if (multiline) op = op->op_next; /* can't assume anything */ else { - match = *(SvPVnx(GvSV(cCOP->cop_gv))) & 255; + match = *(SvPVx(GvSV(cCOP->cop_gv), na)) & 255; match -= cCOP->uop.scop.scop_offset; if (match < 0) match = 0; @@ -6072,14 +6237,15 @@ PP(pp_open) GV *gv; SV *sv; char *tmps; + STRLEN len; if (MAXARG > 1) sv = POPs; else sv = GvSV(TOPs); gv = (GV*)POPs; - tmps = SvPVn(sv); - if (do_open(gv, tmps, SvCUROK(sv))) { + tmps = SvPV(sv, len); + if (do_open(gv, tmps, len)) { GvIO(gv)->lines = 0; PUSHi( (I32)forkprocess ); } @@ -6222,39 +6388,111 @@ PP(pp_binmode) #endif } +PP(pp_tie) +{ + dSP; + SV *varsv; + HV* stash; + GV *gv; + BINOP myop; + SV *sv; + SV **mark = stack_base + *markstack_ptr + 1; /* reuse in entersubr */ + + varsv = mark[0]; + + stash = fetch_stash(mark[1], FALSE); + if (!stash || !(gv = gv_fetchmethod(stash, "new")) || !GvCV(gv)) + DIE("Can't tie to package %s", SvPV(mark[1],na)); + + Zero(&myop, 1, BINOP); + myop.op_last = (OP *) &myop; + myop.op_next = Nullop; + myop.op_flags = OPf_STACKED; + + ENTER; + SAVESPTR(op); + op = (OP *) &myop; + + mark[0] = gv; + PUTBACK; + + if (op = pp_entersubr()) + run(); + SPAGAIN; + + sv = TOPs; + if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) + sv_magic(varsv, sv, 'P', 0, 0); + else + sv_magic(varsv, sv, 'p', 0, -1); + LEAVE; + SPAGAIN; + RETURN; +} + +PP(pp_untie) +{ + dSP; + if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV) + sv_unmagic(TOPs, 'P'); + else + sv_unmagic(TOPs, 'p'); + RETSETYES; +} + PP(pp_dbmopen) { - dSP; dTARGET; - int anum; + dSP; HV *hv; dPOPPOPssrl; + HV* stash; + GV *gv; + BINOP myop; + SV *sv; hv = (HV*)POPs; - if (SvOK(rstr)) - anum = SvIVn(rstr); + + sv = sv_mortalcopy(&sv_no); + sv_setpv(sv, "Any_DBM_File"); + stash = fetch_stash(sv, FALSE); + if (!stash || !(gv = gv_fetchmethod(stash, "new")) || !GvCV(gv)) + DIE("No dbm on this machine"); + + Zero(&myop, 1, BINOP); + myop.op_last = (OP *) &myop; + myop.op_next = Nullop; + myop.op_flags = OPf_STACKED; + + ENTER; + SAVESPTR(op); + op = (OP *) &myop; + PUTBACK; + pp_pushmark(); + + EXTEND(sp, 5); + PUSHs(gv); + PUSHs(sv); + PUSHs(lstr); + if (SvIV(rstr)) + PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT))); else - anum = -1; -#ifdef SOME_DBM - PUSHi( (I32)hv_dbmopen(hv, SvPVn(lstr), anum) ); -#else - DIE("No dbm or ndbm on this machine"); -#endif + PUSHs(sv_2mortal(newSViv(O_RDWR))); + PUSHs(rstr); + PUTBACK; + + if (op = pp_entersubr()) + run(); + LEAVE; + SPAGAIN; + + sv = TOPs; + sv_magic((SV*)hv, sv, 'P', 0, 0); RETURN; } PP(pp_dbmclose) { - dSP; - I32 anum; - HV *hv; - - hv = (HV*)POPs; -#ifdef SOME_DBM - hv_dbmclose(hv); - RETPUSHYES; -#else - DIE("No dbm or ndbm on this machine"); -#endif + return pp_untie(ARGS); } PP(pp_sselect) @@ -6313,7 +6551,7 @@ PP(pp_sselect) sv = SP[4]; if (SvOK(sv)) { - value = SvNVn(sv); + value = SvNV(sv); if (value < 0.0) value = 0.0; timebuf.tv_sec = (long)value; @@ -6332,20 +6570,20 @@ PP(pp_sselect) j = SvLEN(sv); if (j < growsize) { Sv_Grow(sv, growsize); - s = SvPVn(sv) + j; + s = SvPV(sv, na) + j; while (++j <= growsize) { *s++ = '\0'; } } #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 - s = SvPV(sv); + s = SvPVX(sv); New(403, fd_sets[i], growsize, char); for (offset = 0; offset < growsize; offset += masksize) { for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) fd_sets[i][j+offset] = s[(k % masksize) + offset]; } #else - fd_sets[i] = SvPV(sv); + fd_sets[i] = SvPVX(sv); #endif } @@ -6359,7 +6597,7 @@ PP(pp_sselect) for (i = 1; i <= 3; i++) { if (fd_sets[i]) { sv = SP[i]; - s = SvPV(sv); + s = SvPVX(sv); for (offset = 0; offset < growsize; offset += masksize) { for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) s[(k % masksize) + offset] = fd_sets[i][j+offset]; @@ -6412,7 +6650,7 @@ PP(pp_getc) RETPUSHUNDEF; TAINT_IF(1); sv_setpv(TARG, " "); - *SvPV(TARG) = getc(GvIO(gv)->ifp); /* should never be EOF */ + *SvPVX(TARG) = getc(GvIO(gv)->ifp); /* should never be EOF */ PUSHTARG; RETURN; } @@ -6473,7 +6711,7 @@ PP(pp_enterwrite) if (fgv) { SV *tmpstr = sv_mortalcopy(&sv_undef); gv_efullname(tmpstr, gv); - DIE("Undefined format \"%s\" called",SvPV(tmpstr)); + DIE("Undefined format \"%s\" called",SvPVX(tmpstr)); } DIE("Not a format reference"); } @@ -6520,7 +6758,7 @@ PP(pp_leavewrite) io->top_gv = topgv; } if (io->lines_left >= 0 && io->page > 0) - fwrite(SvPV(formfeed), SvCUR(formfeed), 1, ofp); + fwrite(SvPVX(formfeed), SvCUR(formfeed), 1, ofp); io->lines_left = io->page_len; io->page++; formtarget = toptarget; @@ -6547,7 +6785,7 @@ PP(pp_leavewrite) if (dowarn) warn("page overflow"); } - if (!fwrite(SvPV(formtarget), 1, SvCUR(formtarget), ofp) || + if (!fwrite(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) || ferror(fp)) PUSHs(&sv_no); else { @@ -6693,16 +6931,19 @@ PP(pp_sysread) int length; int bufsize; SV *bufstr; + STRLEN blen; gv = (GV*)*++MARK; if (!gv) goto say_undef; bufstr = *++MARK; - buffer = SvPVn(bufstr); - length = SvIVnx(*++MARK); + buffer = SvPV(bufstr, blen); + length = SvIVx(*++MARK); + if (SvREADONLY(bufstr)) + DIE(no_modify); errno = 0; if (MARK < SP) - offset = SvIVnx(*++MARK); + offset = SvIVx(*++MARK); else offset = 0; if (MARK < SP) @@ -6713,14 +6954,14 @@ PP(pp_sysread) #ifdef HAS_SOCKET if (op->op_type == OP_RECV) { bufsize = sizeof buf; - SvGROW(bufstr, length+1), (buffer = SvPVn(bufstr)); /* sneaky */ + SvGROW(bufstr, length+1), (buffer = SvPV(bufstr, blen)); /* sneaky */ length = recvfrom(fileno(io->ifp), buffer, length, offset, buf, &bufsize); if (length < 0) RETPUSHUNDEF; SvCUR_set(bufstr, length); *SvEND(bufstr) = '\0'; - SvNOK_off(bufstr); + SvPOK_only(bufstr); SP = ORIGMARK; sv_setpvn(TARG, buf, bufsize); PUSHs(TARG); @@ -6730,7 +6971,7 @@ PP(pp_sysread) if (op->op_type == OP_RECV) DIE(no_sock_func, "recv"); #endif - SvGROW(bufstr, length+offset+1), (buffer = SvPVn(bufstr)); /* sneaky */ + SvGROW(bufstr, length+offset+1), (buffer = SvPV(bufstr, blen)); /* sneaky */ if (op->op_type == OP_SYSREAD) { length = read(fileno(io->ifp), buffer+offset, length); } @@ -6748,7 +6989,7 @@ PP(pp_sysread) goto say_undef; SvCUR_set(bufstr, length+offset); *SvEND(bufstr) = '\0'; - SvNOK_off(bufstr); + SvPOK_only(bufstr); SP = ORIGMARK; PUSHi(length); RETURN; @@ -6772,13 +7013,14 @@ PP(pp_send) SV *bufstr; char *buffer; int length; + STRLEN blen; gv = (GV*)*++MARK; if (!gv) goto say_undef; bufstr = *++MARK; - buffer = SvPVn(bufstr); - length = SvIVnx(*++MARK); + buffer = SvPV(bufstr, blen); + length = SvIVx(*++MARK); errno = 0; io = GvIO(gv); if (!io || !io->ifp) { @@ -6792,7 +7034,7 @@ PP(pp_send) } else if (op->op_type == OP_SYSWRITE) { if (MARK < SP) - offset = SvIVnx(*++MARK); + offset = SvIVx(*++MARK); else offset = 0; if (MARK < SP) @@ -6801,14 +7043,14 @@ PP(pp_send) } #ifdef HAS_SOCKET else if (SP >= MARK) { + STRLEN mlen; if (SP > MARK) warn("Too many args on send"); - buffer = SvPVnx(*++MARK); - length = sendto(fileno(io->ifp), buffer, SvCUR(bufstr), - length, buffer, SvCUR(*MARK)); + buffer = SvPVx(*++MARK, mlen); + length = sendto(fileno(io->ifp), buffer, blen, length, buffer, mlen); } else - length = send(fileno(io->ifp), buffer, SvCUR(bufstr), length); + length = send(fileno(io->ifp), buffer, blen, length); #else else DIE(no_sock_func, "send"); @@ -6931,27 +7173,26 @@ PP(pp_ioctl) GV *gv = (GV*)POPs; IO *io = GvIOn(gv); - TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl"); - if (!io || !argstr || !io->ifp) { errno = EBADF; /* well, sort of... */ RETPUSHUNDEF; } if (SvPOK(argstr) || !SvNIOK(argstr)) { + STRLEN len; if (!SvPOK(argstr)) - s = SvPVn(argstr); + s = SvPV(argstr, len); retval = IOCPARM_LEN(func); - if (SvCUR(argstr) < retval) { + if (len < retval) { Sv_Grow(argstr, retval+1); SvCUR_set(argstr, retval); } - s = SvPV(argstr); + s = SvPVX(argstr); s[SvCUR(argstr)] = 17; /* a little sanity check here */ } else { - retval = SvIVn(argstr); + retval = SvIV(argstr); #ifdef DOSISH s = (char*)(long)retval; /* ouch */ #else @@ -6959,6 +7200,8 @@ PP(pp_ioctl) #endif } + TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl"); + if (optype == OP_IOCTL) retval = ioctl(fileno(io->ifp), func, s); else @@ -7120,13 +7363,14 @@ PP(pp_bind) char *addr; GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); + STRLEN len; if (!io || !io->ifp) goto nuts; - addr = SvPVn(addrstr); + addr = SvPV(addrstr, len); TAINT_PROPER("bind"); - if (bind(fileno(io->ifp), addr, SvCUR(addrstr)) >= 0) + if (bind(fileno(io->ifp), addr, len) >= 0) RETPUSHYES; else RETPUSHUNDEF; @@ -7149,13 +7393,14 @@ PP(pp_connect) char *addr; GV *gv = (GV*)POPs; register IO *io = GvIOn(gv); + STRLEN len; if (!io || !io->ifp) goto nuts; - addr = SvPVn(addrstr); + addr = SvPV(addrstr, len); TAINT_PROPER("connect"); - if (connect(fileno(io->ifp), addr, SvCUR(addrstr)) >= 0) + if (connect(fileno(io->ifp), addr, len) >= 0) RETPUSHYES; else RETPUSHUNDEF; @@ -7314,12 +7559,12 @@ PP(pp_ssockopt) case OP_GSOCKOPT: SvCUR_set(sv, 256); SvPOK_only(sv); - if (getsockopt(fd, lvl, optname, SvPV(sv), (int*)&SvCUR(sv)) < 0) + if (getsockopt(fd, lvl, optname, SvPVX(sv), (int*)&SvCUR(sv)) < 0) goto nuts2; PUSHs(sv); break; case OP_SSOCKOPT: - if (setsockopt(fd, lvl, optname, SvPV(sv), SvCUR(sv)) < 0) + if (setsockopt(fd, lvl, optname, SvPVX(sv), SvCUR(sv)) < 0) goto nuts2; PUSHs(&sv_yes); break; @@ -7366,11 +7611,11 @@ PP(pp_getpeername) fd = fileno(io->ifp); switch (optype) { case OP_GETSOCKNAME: - if (getsockname(fd, SvPV(sv), (int*)&SvCUR(sv)) < 0) + if (getsockname(fd, SvPVX(sv), (int*)&SvCUR(sv)) < 0) goto nuts2; break; case OP_GETPEERNAME: - if (getpeername(fd, SvPV(sv), (int*)&SvCUR(sv)) < 0) + if (getpeername(fd, SvPVX(sv), (int*)&SvCUR(sv)) < 0) goto nuts2; break; } @@ -7423,12 +7668,12 @@ PP(pp_stat) #ifdef HAS_LSTAT laststype = op->op_type; if (op->op_type == OP_LSTAT) - laststatval = lstat(SvPVn(statname), &statcache); + laststatval = lstat(SvPV(statname, na), &statcache); else #endif - laststatval = stat(SvPVn(statname), &statcache); + laststatval = stat(SvPV(statname, na), &statcache); if (laststatval < 0) { - if (dowarn && strchr(SvPVn(statname), '\n')) + if (dowarn && strchr(SvPV(statname, na), '\n')) warn(warn_nl, "stat"); max = 0; } @@ -7806,11 +8051,11 @@ PP(pp_fttext) else { sv = POPs; statgv = Nullgv; - sv_setpv(statname, SvPVn(sv)); + sv_setpv(statname, SvPV(sv, na)); really_filename: - i = open(SvPVn(sv), 0); + i = open(SvPV(sv, na), 0); if (i < 0) { - if (dowarn && strchr(SvPVn(sv), '\n')) + if (dowarn && strchr(SvPV(sv, na), '\n')) warn(warn_nl, "open"); RETPUSHUNDEF; } @@ -7867,12 +8112,12 @@ PP(pp_chdir) if (!tmps || !*tmps) { svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE); if (svp) - tmps = SvPVn(*svp); + tmps = SvPV(*svp, na); } if (!tmps || !*tmps) { svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE); if (svp) - tmps = SvPVn(*svp); + tmps = SvPV(*svp, na); } TAINT_PROPER("chdir"); PUSHi( chdir(tmps) >= 0 ); @@ -7899,7 +8144,7 @@ PP(pp_chroot) char *tmps; #ifdef HAS_CHROOT if (MAXARG < 1) - tmps = SvPVnx(GvSV(defgv)); + tmps = SvPVx(GvSV(defgv), na); else tmps = POPp; TAINT_PROPER("chroot"); @@ -7946,7 +8191,7 @@ PP(pp_rename) int anum; char *tmps2 = POPp; - char *tmps = SvPVn(TOPs); + char *tmps = SvPV(TOPs, na); TAINT_PROPER("rename"); #ifdef HAS_RENAME anum = rename(tmps, tmps2); @@ -7969,7 +8214,7 @@ PP(pp_link) dSP; dTARGET; #ifdef HAS_LINK char *tmps2 = POPp; - char *tmps = SvPVn(TOPs); + char *tmps = SvPV(TOPs, na); TAINT_PROPER("link"); SETi( link(tmps, tmps2) >= 0 ); #else @@ -7983,7 +8228,7 @@ PP(pp_symlink) dSP; dTARGET; #ifdef HAS_SYMLINK char *tmps2 = POPp; - char *tmps = SvPVn(TOPs); + char *tmps = SvPV(TOPs, na); TAINT_PROPER("symlink"); SETi( symlink(tmps, tmps2) >= 0 ); RETURN; @@ -7999,7 +8244,7 @@ PP(pp_readlink) char *tmps; int len; if (MAXARG < 1) - tmps = SvPVnx(GvSV(defgv)); + tmps = SvPVx(GvSV(defgv), na); else tmps = POPp; len = readlink(tmps, buf, sizeof buf); @@ -8065,7 +8310,7 @@ char *filename; return 0; } else { /* some mkdirs return no failure indication */ - tmps = SvPVnx(st[1]); + tmps = SvPVx(st[1], na); anum = (stat(tmps, &statbuf) >= 0); if (op->op_type == OP_RMDIR) anum = !anum; @@ -8086,7 +8331,7 @@ PP(pp_mkdir) dSP; dTARGET; int mode = POPi; int oldumask; - char *tmps = SvPVn(TOPs); + char *tmps = SvPV(TOPs, na); TAINT_PROPER("mkdir"); #ifdef HAS_MKDIR @@ -8106,7 +8351,7 @@ PP(pp_rmdir) char *tmps; if (MAXARG < 1) - tmps = SvPVnx(GvSV(defgv)); + tmps = SvPVx(GvSV(defgv), na); else tmps = POPp; TAINT_PROPER("rmdir"); @@ -8300,9 +8545,9 @@ PP(pp_fork) RETSETUNDEF; if (!childpid) { /*SUPPRESS 560*/ - if (tmpgv = gv_fetchpv("$", allgvs)) + if (tmpgv = gv_fetchpv("$", TRUE)) sv_setiv(GvSV(tmpgv), (I32)getpid()); - hv_clear(pidstatus, FALSE); /* no kids, so don't wait for 'em */ + hv_clear(pidstatus); /* no kids, so don't wait for 'em */ } PUSHi(childpid); RETURN; @@ -8365,9 +8610,11 @@ PP(pp_system) #ifdef HAS_FORK if (SP - MARK == 1) { - TAINT_ENV(); - TAINT_IF(TOPs->sv_tainted); - TAINT_PROPER("system"); + if (tainting) { + char *junk = SvPV(TOPs, na); + TAINT_ENV(); + TAINT_PROPER("system"); + } } while ((childpid = vfork()) == -1) { if (errno != EAGAIN) { @@ -8402,7 +8649,7 @@ PP(pp_system) else if (SP - MARK != 1) value = (I32)do_aexec(Nullsv, MARK, SP); else { - value = (I32)do_exec(SvPVnx(sv_mortalcopy(*SP))); + value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na)); } _exit(-1); #else /* ! FORK */ @@ -8411,7 +8658,7 @@ PP(pp_system) else if (arglast[2] - arglast[1] != 1) value = (I32)do_aspawn(Nullsv, arglast); else { - value = (I32)do_spawn(SvPVnx(sv_mortalcopy(st[2]))); + value = (I32)do_spawn(SvPVx(sv_mortalcopy(st[2]), na)); } PUSHi(value); #endif /* FORK */ @@ -8430,10 +8677,12 @@ PP(pp_exec) else if (SP - MARK != 1) value = (I32)do_aexec(Nullsv, MARK, SP); else { - TAINT_ENV(); - TAINT_IF((*SP)->sv_tainted); - TAINT_PROPER("exec"); - value = (I32)do_exec(SvPVnx(sv_mortalcopy(*SP))); + if (tainting) { + char *junk = SvPV(*SP, na); + TAINT_ENV(); + TAINT_PROPER("exec"); + } + value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na)); } SP = ORIGMARK; PUSHi(value); @@ -8475,7 +8724,7 @@ PP(pp_getpgrp) if (MAXARG < 1) pid = 0; else - pid = SvIVnx(POPs); + pid = SvIVx(POPs); #ifdef _POSIX_SOURCE if (pid != 0) DIE("POSIX getpgrp can't take an argument"); @@ -8589,7 +8838,7 @@ PP(pp_gmtime) if (MAXARG < 1) (void)time(&when); else - when = (time_t)SvIVnx(POPs); + when = (time_t)SvIVx(POPs); if (op->op_type == OP_LOCALTIME) tmbuf = localtime(&when); @@ -8630,15 +8879,12 @@ PP(pp_alarm) { dSP; dTARGET; int anum; - char *tmps; #ifdef HAS_ALARM if (MAXARG < 1) - tmps = SvPVnx(GvSV(defgv)); + anum = SvIVx(GvSV(defgv)); else - tmps = POPp; - if (!tmps) - tmps = "0"; - anum = alarm((unsigned int)atoi(tmps)); + anum = POPi; + anum = alarm((unsigned int)anum); EXTEND(SP, 1); if (anum < 0) RETPUSHUNDEF; @@ -8795,8 +9041,8 @@ save_lines(array, sv) AV *array; SV *sv; { - register char *s = SvPV(sv); - register char *send = SvPV(sv) + SvCUR(sv); + register char *s = SvPVX(sv); + register char *send = SvPVX(sv) + SvCUR(sv); register char *t; register I32 line = 1; @@ -8824,7 +9070,6 @@ doeval() HV *newstash; in_eval = 1; - reinit_lexer(); /* set up a scratch pad */ @@ -8859,12 +9104,14 @@ 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); @@ -8875,20 +9122,21 @@ doeval() eval_root = Nullop; } if (optype == OP_REQUIRE) - DIE("%s", SvPVnx(GvSV(gv_fetchpv("@",TRUE)))); + DIE("%s", SvPVx(GvSV(gv_fetchpv("@",TRUE)), na)); rs = nrs; rslen = nrslen; rschar = nrschar; rspara = (nrslen == 2); RETPUSHUNDEF; } + lex_end(); rs = nrs; rslen = nrslen; rschar = nrschar; rspara = (nrslen == 2); compiling.cop_line = 0; - DEBUG_x(dump_eval(eval_root, eval_start)); + DEBUG_x(dump_eval()); /* compiled okay, so do it */ @@ -8906,7 +9154,7 @@ PP(pp_require) dSP; register CONTEXT *cx; dPOPss; - char *name = SvPVn(sv); + char *name = SvPV(sv, na); char *tmpname; SV** svp; I32 gimme = G_SCALAR; @@ -8934,7 +9182,8 @@ PP(pp_require) I32 i; for (i = 0; i <= AvFILL(ar); i++) { - (void)sprintf(buf, "%s/%s", SvPVnx(*av_fetch(ar, i, TRUE)), name); + (void)sprintf(buf, "%s/%s", + SvPVx(*av_fetch(ar, i, TRUE), na), name); rsfp = fopen(buf, "r"); if (rsfp) { char *s = buf; @@ -9178,7 +9427,7 @@ PP(pp_ghostent) else if (which == OP_GHBYADDR) { int addrtype = POPi; SV *addrstr = POPs; - char *addr = SvPVn(addrstr); + char *addr = SvPV(addrstr, na); hent = gethostbyaddr(addr, SvCUR(addrstr), addrtype); } @@ -9794,12 +10043,14 @@ PP(pp_syscall) register I32 i = 0; I32 retval = -1; -#ifdef TAINT - while (++MARK <= SP) - TAINT_IF((*MARK)->sv_tainted); - MARK = ORIGMARK; - TAINT_PROPER("syscall"); -#endif + if (tainting) { + while (++MARK <= SP) { + if (SvMAGICAL(*MARK) && mg_find(*MARK, 't')) + tainted = TRUE; + } + MARK = ORIGMARK; + TAINT_PROPER("syscall"); + } /* This probably won't work on machines where sizeof(long) != sizeof(int) * or where sizeof(long) != sizeof(char*). But such machines will @@ -9807,9 +10058,9 @@ PP(pp_syscall) */ while (++MARK <= SP) { if (SvNIOK(*MARK) || !i) - a[i++] = SvIVn(*MARK); + a[i++] = SvIV(*MARK); else - a[i++] = (unsigned long)SvPV(*MARK); + a[i++] = (unsigned long)SvPVX(*MARK); if (i > 15) break; } @@ -20,7 +20,7 @@ **********************************************************/ #define ARGS -#define ARGSproto +#define ARGSproto void #define dARGS #define PP(s) OP* s(ARGS) dARGS @@ -70,16 +70,16 @@ #define RETURNX(x) return x, PUTBACK, NORMAL #define POPs (*sp--) -#define POPp (SvPVnx(POPs)) -#define POPn (SvNVnx(POPs)) -#define POPi ((int)SvIVnx(POPs)) -#define POPl ((long)SvIVnx(POPs)) +#define POPp (SvPVx(POPs, na)) +#define POPn (SvNVx(POPs)) +#define POPi ((int)SvIVx(POPs)) +#define POPl ((long)SvIVx(POPs)) #define TOPs (*sp) -#define TOPp (SvPVn(TOPs)) -#define TOPn (SvNVn(TOPs)) -#define TOPi ((int)SvIVn(TOPs)) -#define TOPl ((long)SvIVn(TOPs)) +#define TOPp (SvPV(TOPs, na)) +#define TOPn (SvNV(TOPs)) +#define TOPi ((int)SvIV(TOPs)) +#define TOPl ((long)SvIV(TOPs)) /* Go to some pains in the rare event that we must extend the stack. */ #define EXTEND(p,n) do { if (stack_max - p < (n)) { \ @@ -7,12 +7,12 @@ OP* append_elem P((I32 optype, OP* head, OP* tail)); OP* append_list P((I32 optype, LISTOP* first, LISTOP* last)); I32 apply P((I32 type, SV** mark, SV** sp)); void av_clear P((AV* ar)); -AV* av_fake P((I32 size, SV** strp)); +AV* av_fake P((I32 size, SV** svp)); SV** av_fetch P((AV* ar, I32 key, I32 lval)); void av_fill P((AV* ar, I32 fill)); void av_free P((AV* ar)); I32 av_len P((AV* ar)); -AV* av_make P((I32 size, SV** strp)); +AV* av_make P((I32 size, SV** svp)); SV* av_pop P((AV* ar)); void av_popnulls P((AV* ar)); bool av_push P((AV* ar, SV* val)); @@ -24,7 +24,7 @@ OP* bind_match P((I32 type, OP* left, OP* pat)); OP* block_head P((OP* o, OP** startp)); void calllist P((AV* list)); I32 cando P((I32 bit, I32 effective, struct stat* statbufp)); -unsigned long cast_ulong P((double f)); +U32 cast_ulong P((double f)); void checkcomma P((char* s, char* name, char* what)); I32 chsize P((int fd, off_t length)); OP* convert P((I32 optype, I32 flags, OP* op)); @@ -32,17 +32,19 @@ OP* cop_to_arg P((OP* cmd)); I32 copyopt P((OP* cmd, OP* which)); void cpy7bit P((char* d, char* s, I32 l)); char* cpytill P((char* to, char* from, char* fromend, I32 delim, I32* retlen)); +void croak P((char* pat,...)); void cryptfilter P((FILE* fil)); void cryptswitch P((void)); -void deb P((va_alist)); +void cv_clear P((CV* cv)); +void deb P((char* pat,...)); void deb_growlevel P((void)); -OP* die P((va_alist)); +OP* die P((char* pat,...)); OP* die_where P((char* message)); void do_accept P((SV* sv, GV* ngv, GV* ggv)); bool do_aexec P((SV* really, SV** mark, SV** sp)); -void do_chop P((SV* astr, SV* sv)); +void do_chop P((SV* asv, SV* sv)); bool do_close P((GV* gv, bool explicit)); -int do_ctl P((I32 optype, GV* gv, I32 func, SV* argstr)); +int do_ctl P((I32 optype, GV* gv, I32 func, SV* argsv)); bool do_eof P((GV* gv)); bool do_exec P((char* cmd)); void do_execfree P((void)); @@ -50,7 +52,7 @@ SV* do_fttext P((OP* arg, SV* sv)); I32 do_ipcctl P((I32 optype, SV** mark, SV** sp)); I32 do_ipcget P((I32 optype, SV** mark, SV** sp)); void do_join P((SV* sv, SV* del, SV** mark, SV** sp)); -OP* do_kv P(()); +OP* do_kv P((void)); I32 do_msgrcv P((SV** mark, SV** sp)); I32 do_msgsnd P((SV** mark, SV** sp)); bool do_open P((GV* gv, char* name, I32 len)); @@ -68,21 +70,22 @@ void do_vop P((I32 optype, SV* sv, SV* left, SV* right)); void do_write P((struct Outrec* orec, GV* gv)); void dump_all P((void)); void dump_cop P((OP* cmd, OP* alt)); -void dump_eval P(()); - dump_fds P((char* s)); +void dump_eval P((void)); +int dump_fds P((char* s)); void dump_flags P((char* b, U32 flags)); void dump_gv P((GV* gv)); void dump_op P((OP* arg)); void dump_pm P((PMOP* pm)); +void dump_packsubs P((HV* stash)); void dump_sub P((GV* gv)); - dup2 P((int oldfd, int newfd)); void fbm_compile P((SV* sv, I32 iflag)); -char* fbm_instr P((unsigned char* big, unsigned char* bigend, SV* littlestr)); +char* fbm_instr P((unsigned char* big, unsigned char* bigend, SV* littlesv)); IO* fetch_io P((OP* op, I32 num)); GV* fetch_gv P((OP* op, I32 num)); +HV* fetch_stash P((SV* sv, I32 create)); OP* flatten P((OP* arg)); void force_ident P((char* s)); -char* force_word P((char* s, int token)); +char* force_word P((char* start, int token, int check_keyword, int allow_tick)); OP* forcelist P((OP* arg)); void free_tmps P((void)); OP* gen_constant_list P((OP* op)); @@ -91,7 +94,7 @@ void gp_free P((GV* gv)); GP* gp_ref P((GP* gp)); GV* gv_AVadd P((GV* gv)); GV* gv_HVadd P((GV* gv)); -void gv_check P((I32 min, I32 max)); +void gv_check P((HV* stash)); void gv_efullname P((SV* sv, GV* gv)); GV* gv_fetchfile P((char* name)); GV* gv_fetchmethod P((HV* stash, char* name)); @@ -103,27 +106,32 @@ OP* gv_to_op P((I32 atype, GV* gv)); void he_delayfree P((HE* hent)); void he_free P((HE* hent)); void hoistmust P((PMOP* pm)); -void hv_clear P((HV* tb, I32 dodbm)); -void hv_dbmclose P((HV* tb)); -bool hv_dbmopen P((HV* tb, char* fname, int mode)); -bool hv_dbmstore P((HV* tb, char* key, U32 klen, SV* sv)); +void hv_clear P((HV* tb)); SV* hv_delete P((HV* tb, char* key, U32 klen)); SV** hv_fetch P((HV* tb, char* key, U32 klen, I32 lval)); -void hv_free P((HV* tb, I32 dodbm)); +void hv_free P((HV* tb)); I32 hv_iterinit P((HV* tb)); char* hv_iterkey P((HE* entry, I32* retlen)); HE* hv_iternext P((HV* tb)); SV* hv_iterval P((HV* tb, HE* entry)); void hv_magic P((HV* hv, GV* gv, I32 how)); SV** hv_store P((HV* tb, char* key, U32 klen, SV* val, U32 hash)); -void hv_undef P((HV* tb, I32 dodbm)); +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)); OP* linklist P((OP* op)); OP* list P((OP* o)); OP* listkids P((OP* o)); @@ -131,26 +139,31 @@ OP* localize P((OP* arg, I32 lexical)); I32 looks_like_number P((SV* sv)); OP* loopscope P((OP* o)); I32 lop P((I32 f, char* s)); +int magic_clearpack P((SV* sv, MAGIC* mg)); int magic_get P((SV* sv, MAGIC* mg)); int magic_getarylen P((SV* sv, MAGIC* mg)); +int magic_getpack P((SV* sv, MAGIC* mg)); int magic_getglob P((SV* sv, MAGIC* mg)); +int magic_gettaint P((SV* sv, MAGIC* mg)); int magic_getuvar P((SV* sv, MAGIC* mg)); U32 magic_len P((SV* sv, MAGIC* mg)); int magic_set P((SV* sv, MAGIC* mg)); int magic_setarylen P((SV* sv, MAGIC* mg)); int magic_setbm P((SV* sv, MAGIC* mg)); +int magic_setpack P((SV* sv, MAGIC* mg)); int magic_setdbline P((SV* sv, MAGIC* mg)); -int magic_setdbm P((SV* sv, MAGIC* mg)); int magic_setenv P((SV* sv, MAGIC* mg)); +int magic_setisa P((SV* sv, MAGIC* mg)); int magic_setglob P((SV* sv, MAGIC* mg)); int magic_setmglob P((SV* sv, MAGIC* mg)); int magic_setsig P((SV* sv, MAGIC* mg)); int magic_setsubstr P((SV* sv, MAGIC* mg)); +int magic_settaint P((SV* sv, MAGIC* mg)); int magic_setuvar P((SV* sv, MAGIC* mg)); int magic_setvec P((SV* sv, MAGIC* mg)); void magicalize P((char* list)); void magicname P((char* sym, char* name, I32 namlen)); - main P((int argc, char** argv, char** env)); +int main P((int argc, char** argv, char** env)); #ifndef STANDARD_C MALLOCPTRTYPE* malloc P((MEM_SIZE nbytes)); #endif @@ -158,23 +171,23 @@ OP* maybeforcelist P((I32 optype, OP* arg)); char* mess P((char* pat, ...)); int mg_clear P((SV* sv)); MAGIC* mg_find P((SV* sv, char type)); -int mg_free P((SV* sv, char type)); -int mg_freeall P((SV* sv)); +int mg_free P((SV* sv)); int mg_get P((SV* sv)); U32 mg_len P((SV* sv)); int mg_set P((SV* sv)); +OP* mod P((OP* op, I32 type)); char* moreswitches P((char* s)); void mstats P((char* s)); char* my_bcopy P((char* from, char* to, I32 len)); char* my_bzero P((char* loc, I32 len)); void my_exit P((I32 status)); -I32 my_lstat P(()); +I32 my_lstat P((void)); I32 my_memcmp P((unsigned char* s1, unsigned char* s2, I32 len)); I32 my_pclose P((FILE* ptr)); FILE* my_pfiopen P((FILE* fil, VOID (*func)())); FILE* my_popen P((char* cmd, char* mode)); void my_setenv P((char* nam, char* val)); -I32 my_stat P(()); +I32 my_stat P((void)); short my_swap P((short s)); void my_unexec P((void)); OP* newANONLIST P((OP* op)); @@ -184,7 +197,6 @@ OP* newBINOP P((I32 optype, I32 flags, OP* left, OP* right)); 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)); -HV* newHV P((U32 lookat)); OP* newLOGOP P((I32 optype, I32 flags, OP* left, OP* right)); OP* newLOOPOP P((I32 flags, I32 debuggable, OP* expr, OP* block)); OP* newMETHOD P((OP* ref, OP* name)); @@ -196,6 +208,7 @@ OP* newSLICEOP P((I32 flags, OP* subscript, OP* list)); OP* newSTATEOP P((I32 flags, char* label, OP* o)); void newSUB P((I32 floor, OP* op, OP* block)); OP* newUNOP P((I32 optype, I32 flags, OP* child)); +void newXSUB P((char *name, I32 ix, I32 (*subaddr)(int,int,int), char *filename)); AV* newAV P((void)); OP* newAVREF P((OP* o)); OP* newBINOP P((I32 type, I32 flags, OP* first, OP* last)); @@ -204,7 +217,7 @@ OP* newGVOP P((I32 type, I32 flags, GV* gv)); GV* newGVgen P((void)); OP* newGVREF P((OP* o)); OP* newHVREF P((OP* o)); -HV* newHV P((U32 lookat)); +HV* newHV P((void)); IO* newIO P((void)); OP* newLISTOP P((I32 type, I32 flags, OP* first, OP* last)); OP* newPMOP P((I32 type, I32 flags)); @@ -221,6 +234,7 @@ SV* newSVnv P((double n)); SV* newSVpv P((char* s, STRLEN len)); SV* newSVsv P((SV* old)); OP* newUNOP P((I32 type, I32 flags, OP* first)); +OP * newWHILEOP P((I32 flags, I32 debuggable, LOOP* loop, OP* expr, OP* block, OP* cont)); FILE* nextargv P((GV* gv)); char* ninstr P((char* big, char* bigend, char* little, char* lend)); char* nsavestr P((char* sv, I32 len)); @@ -232,6 +246,8 @@ OP* over P((GV* eachgv, OP* cmd)); PADOFFSET pad_alloc P((I32 optype, char tmptype)); PADOFFSET pad_allocmy P((char* name)); PADOFFSET pad_findmy P((char* name)); +OP* oopsAV P((OP* o)); +OP* oopsHV P((OP* o)); void pad_leavemy P((I32 fill)); SV* pad_sv P((PADOFFSET po)); void pad_free P((PADOFFSET po)); @@ -245,6 +261,7 @@ I32 perl_callv P((char* subname, I32 sp, I32 gimme, char** argv)); void perl_construct P((PerlInterpreter* sv_interp)); void perl_destruct P((PerlInterpreter* sv_interp)); void perl_free P((PerlInterpreter* sv_interp)); +void perl_init_ext P((void)); I32 perl_parse P((PerlInterpreter* sv_interp, int argc, char** argv, char** env)); I32 perl_run P((PerlInterpreter* sv_interp)); void pidgone P((int pid, int status)); @@ -262,7 +279,6 @@ I32 regexec P((regexp* prog, char* stringarg, char* strend, char* strbeg, I32 mi void regfree P((struct regexp* r)); char* regnext P((char* p)); char* regprop P((char* op)); -void reinit_lexer P((void)); void repeatcpy P((char* to, char* from, I32 len, I32 count)); char* rninstr P((char* big, char* bigend, char* little, char* lend)); void run_format P((struct Outrec* orec, FF* fcmd)); @@ -283,7 +299,6 @@ void save_hptr P((HV** hptr)); void save_I32 P((I32* intp)); void save_int P((int* intp)); void save_item P((SV* item)); -void save_lines P((AV* array, SV* sv)); void save_list P((SV** sarg, I32 maxsarg)); void save_nogv P((GV* gv)); SV* save_scalar P((GV* gv)); @@ -307,25 +322,27 @@ void scan_prefix P((PMOP* pm, char* string, I32 len)); char* scan_str P((char* start)); char* scan_subst P((char* start)); char* scan_trans P((char* start)); +char* scan_word P((char* s, char* dest, int allow_package, STRLEN *slp)); OP* scope P((OP* o)); -char* screaminstr P((SV* bigstr, SV* littlestr)); +char* screaminstr P((SV* bigsv, SV* littlesv)); I32 setenv_getix P((char* nam)); char* skipspace P((char* s)); +bool sv_2bool P((SV* sv)); CV* sv_2cv P((SV* sv, HV** st, GV** gvp, I32 lref)); I32 sv_2iv P((SV* sv)); SV* sv_2mortal P((SV* sv)); double sv_2nv P((SV* sv)); -char* sv_2pv P((SV* sv)); +char* sv_2pv P((SV* sv, STRLEN* lp)); char* sv_append_till P((SV* sv, char* from, char* fromend, I32 delim, char* keeplist)); int sv_backoff P((SV* sv)); void sv_catpv P((SV* sv, char* ptr)); void sv_catpvn P((SV* sv, char* ptr, STRLEN len)); -void sv_catsv P((SV* dstr, SV* sstr)); +void sv_catsv P((SV* dsv, SV* ssv)); void sv_chop P((SV* sv, char* ptr)); void sv_clear P((SV* sv)); -I32 sv_cmp P((SV* str1, SV* str2)); +I32 sv_cmp P((SV* sv1, SV* sv2)); void sv_dec P((SV* sv)); -I32 sv_eq P((SV* str1, SV* str2)); +I32 sv_eq P((SV* sv1, SV* sv2)); void sv_free P((SV* sv)); char* sv_gets P((SV* sv, FILE* fp, I32 append)); #ifndef DOSISH @@ -334,27 +351,30 @@ char* sv_grow P((SV* sv, I32 newlen)); char* sv_grow P((SV* sv, unsigned long newlen)); #endif void sv_inc P((SV* sv)); -void sv_insert P((SV* bigstr, STRLEN offset, STRLEN len, char* little, STRLEN littlelen)); +void sv_insert P((SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen)); SV* sv_interp P((SV* sv, SV* src, I32 sp)); void sv_intrpcompile P((SV* src)); STRLEN sv_len P((SV* sv)); -void sv_magic P((SV* sv, SV* obj, char how, char* name, STRLEN namlen)); -SV* sv_mortalcopy P((SV* oldstr)); +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)); -void sv_replace P((SV* sv, SV* nstr)); +void sv_replace P((SV* sv, SV* nsv)); void sv_reset P((char* s, HV* stash)); void sv_setiv P((SV* sv, I32 num)); void sv_setnv P((SV* sv, double num)); void sv_setpv P((SV* sv, char* ptr)); void sv_setpvn P((SV* sv, char* ptr, STRLEN len)); -void sv_setsv P((SV* dstr, SV* sstr)); +void sv_setsv P((SV* dsv, SV* ssv)); +int sv_unmagic P((SV* sv, char type)); +void sv_usepvn P((SV* sv, char* ptr, STRLEN len)); void taint_env P((void)); +void taint_not P((char *s)); void taint_proper P((char* f, char* s)); I32 uni P((I32 f, char* s)); I32 unlnk P((char* f)); I32 userinit P((void)); I32 wait4pid P((int pid, int* statusp, int flags)); -void warn P((va_alist)); +void warn P((char* pat,...)); I32 whichsig P((char* sig)); void while_io P((OP* cmd)); OP* wopt P((OP* cmd)); @@ -163,7 +163,7 @@ I32 fold; I32 sawopen = 0; if (exp == NULL) - fatal("NULL regexp argument"); + croak("NULL regexp argument"); /* First pass: determine size, legality. */ regfold = fold; @@ -349,8 +349,8 @@ I32 fold; && (!r->regstart || - !fbm_instr((unsigned char*) SvPV(r->regstart), - (unsigned char *) SvPV(r->regstart) + !fbm_instr((unsigned char*) SvPVX(r->regstart), + (unsigned char *) SvPVX(r->regstart) + SvCUR(r->regstart), longest) ) @@ -564,7 +564,7 @@ I32 *flagp; if (!tmp && *max != '0') tmp = 32767; /* meaning "infinity" */ if (tmp && tmp < iter) - fatal("Can't do {n,m} with n > m"); + croak("Can't do {n,m} with n > m"); if (regcode != ®dummy) { #ifdef REGALIGN *(unsigned short *)(ret+3) = iter; @@ -584,7 +584,7 @@ I32 *flagp; *max = ch; if (*max == ',' && max[1] != '}') { if (atoi(max+1) <= 0) - fatal("Can't do {n,m} with n > m"); + croak("Can't do {n,m} with n > m"); ch = *next; sprintf(max+1,"%.*d", next-(max+1), atoi(max+1) - 1); *next = ch; @@ -620,10 +620,10 @@ I32 *flagp; } } else - fatal("Can't do {n,0}"); + croak("Can't do {n,0}"); } else - fatal("Can't do {0}"); + croak("Can't do {0}"); } } @@ -1324,7 +1324,7 @@ regexp *r; /* Header fields of interest. */ if (r->regstart) - fprintf(stderr,"start `%s' ", SvPV(r->regstart)); + fprintf(stderr,"start `%s' ", SvPVX(r->regstart)); if (r->regstclass) fprintf(stderr,"stclass `%s' ", regprop(r->regstclass)); if (r->reganch & ROPT_ANCH) @@ -1334,7 +1334,7 @@ regexp *r; if (r->reganch & ROPT_IMPLICIT) fprintf(stderr,"implicit "); if (r->regmust != NULL) - fprintf(stderr,"must have \"%s\" back %d ", SvPV(r->regmust), + fprintf(stderr,"must have \"%s\" back %d ", SvPVX(r->regmust), r->regback); fprintf(stderr, "minlen %d ", r->minlen); fprintf(stderr,"\n"); @@ -189,4 +189,4 @@ EXT char regdummy; #define UCHARAT(p) regdummy #endif /* lint */ -#define FAIL(m) fatal("/%s/: %s",regprecomp,m) +#define FAIL(m) croak("/%s/: %s",regprecomp,m) @@ -110,7 +110,7 @@ I32 safebase; /* no need to remember string in subbase */ /* Be paranoid... */ if (prog == NULL || string == NULL) { - fatal("NULL regexp parameter"); + croak("NULL regexp parameter"); return(0); } @@ -228,7 +228,7 @@ I32 safebase; /* no need to remember string in subbase */ if (prog->regstart) { if (prog->reganch & ROPT_SKIP) { /* we have /x+whatever/ */ /* it must be a one character string */ - i = SvPV(prog->regstart)[0]; + i = SvPVX(prog->regstart)[0]; while (s < strend) { if (*s == i) { if (regtry(prog, s)) @@ -255,7 +255,7 @@ I32 safebase; /* no need to remember string in subbase */ } } else { - c = SvPV(prog->regstart); + c = SvPVX(prog->regstart); while ((s = ninstr(s, strend, c, c + SvCUR(prog->regstart) )) != NULL) { if (regtry(prog, s)) @@ -52,7 +52,7 @@ OP *op; if (cGVOP->op_gv) { sv = NEWSV(0,0); gv_fullname(sv, cGVOP->op_gv); - fprintf(stderr, "(%s)", SvPVn(sv)); + fprintf(stderr, "(%s)", SvPV(sv, na)); sv_free(sv); } else @@ -73,8 +73,12 @@ free_tmps() while (tmps_ix > myfloor) { /* clean up after last statement */ SV* sv = tmps_stack[tmps_ix]; tmps_stack[tmps_ix--] = Nullsv; - if (sv) + if (sv) { +#ifdef DEBUGGING + SvTEMP_off(sv); +#endif sv_free(sv); /* note, can modify tmps_ix!!! */ + } } } @@ -275,7 +279,7 @@ I32 base; register void* ptr; if (base < -1) - fatal("panic: corrupt saved stack index"); + croak("panic: corrupt saved stack index"); while (savestack_ix > base) { switch (SSPOPINT) { case SAVEt_ITEM: /* normal string */ @@ -312,7 +316,7 @@ I32 base; case SAVEt_HV: /* hash reference */ hv = (HV*)SSPOPPTR; gv = (GV*)SSPOPPTR; - (void)hv_free(GvHV(gv), FALSE); + (void)hv_free(GvHV(gv)); GvHV(gv) = hv; break; case SAVEt_INT: /* int reference */ @@ -346,7 +350,7 @@ I32 base; GvGP(gv) = (GP*)ptr; break; default: - fatal("panic: leave_scope inconsistency"); + croak("panic: leave_scope inconsistency"); } } } @@ -50,6 +50,246 @@ static void ucase(); static void lcase(); +static SV* sv_root; + +static SV* more_sv(); + +static SV* +new_sv() +{ + SV* sv; + if (sv_root) { + sv = sv_root; + sv_root = (SV*)SvANY(sv); + return sv; + } + return more_sv(); +} + +static void +del_sv(p) +SV* p; +{ + SvANY(p) = sv_root; + sv_root = p; +} + +static SV* +more_sv() +{ + register int i; + register SV* sv; + register SV* svend; + sv_root = (SV*)malloc(1008); + sv = sv_root; + svend = &sv[1008 / sizeof(SV) - 1]; + while (sv < svend) { + SvANY(sv) = (SV*)(sv + 1); + sv++; + } + SvANY(sv) = 0; + return new_sv(); +} + +static I32* xiv_root; + +static XPVIV* more_xiv(); + +static XPVIV* +new_xiv() +{ + I32* xiv; + if (xiv_root) { + xiv = xiv_root; + xiv_root = *(I32**)xiv; + return (XPVIV*)((char*)xiv - sizeof(XPV)); + } + return more_xiv(); +} + +static void +del_xiv(p) +XPVIV* p; +{ + I32* xiv = (I32*)((char*)(p) + sizeof(XPV)); + *(I32**)xiv = xiv_root; + xiv_root = xiv; +} + +static XPVIV* +more_xiv() +{ + register int i; + register I32* xiv; + register I32* xivend; + xiv = (I32*)malloc(1008); + xivend = &xiv[1008 / sizeof(I32) - 1]; + xiv += (sizeof(XPV) - 1) / sizeof(I32) + 1; /* fudge by size of XPV */ + xiv_root = xiv; + while (xiv < xivend) { + *(I32**)xiv = (I32*)(xiv + 1); /* XXX busted on Alpha? */ + xiv++; + } + *(I32**)xiv = 0; + return new_xiv(); +} + +static double* xnv_root; + +static XPVNV* more_xnv(); + +static XPVNV* +new_xnv() +{ + double* xnv; + if (xnv_root) { + xnv = xnv_root; + xnv_root = *(double**)xnv; + return (XPVNV*)((char*)xnv - sizeof(XPVIV)); + } + return more_xnv(); +} + +static void +del_xnv(p) +XPVNV* p; +{ + double* xnv = (double*)((char*)(p) + sizeof(XPVIV)); + *(double**)xnv = xnv_root; + xnv_root = xnv; +} + +static XPVNV* +more_xnv() +{ + register int i; + register double* xnv; + register double* xnvend; + xnv = (double*)malloc(1008); + xnvend = &xnv[1008 / sizeof(double) - 1]; + xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */ + xnv_root = xnv; + while (xnv < xnvend) { + *(double**)xnv = (double*)(xnv + 1); + xnv++; + } + *(double**)xnv = 0; + return new_xnv(); +} + +static XPV* xpv_root; + +static XPV* more_xpv(); + +static XPV* +new_xpv() +{ + XPV* xpv; + if (xpv_root) { + xpv = xpv_root; + xpv_root = (XPV*)xpv->xpv_pv; + return xpv; + } + return more_xpv(); +} + +static void +del_xpv(p) +XPV* p; +{ + p->xpv_pv = (char*)xpv_root; + xpv_root = p; +} + +static XPV* +more_xpv() +{ + register int i; + register XPV* xpv; + register XPV* xpvend; + xpv_root = (XPV*)malloc(1008); + xpv = xpv_root; + xpvend = &xpv[1008 / sizeof(XPV) - 1]; + while (xpv < xpvend) { + xpv->xpv_pv = (char*)(xpv + 1); + xpv++; + } + xpv->xpv_pv = 0; + return new_xpv(); +} + +#ifdef PURIFY + +#define new_SV() sv = (SV*)malloc(sizeof(SV)) +#define del_SV(p) free((char*)p) + +#else + +#define new_SV() \ + if (sv_root) { \ + sv = sv_root; \ + sv_root = (SV*)SvANY(sv); \ + } \ + else \ + sv = more_sv(); +#define del_SV(p) del_sv(p) + +#endif + +#ifdef PURIFY +#define new_XIV() (void*)malloc(sizeof(XPVIV)) +#define del_XIV(p) free((char*)p) +#else +#define new_XIV() new_xiv() +#define del_XIV(p) del_xiv(p) +#endif + +#ifdef PURIFY +#define new_XNV() (void*)malloc(sizeof(XPVNV)) +#define del_XNV(p) free((char*)p) +#else +#define new_XNV() new_xnv() +#define del_XNV(p) del_xnv(p) +#endif + +#ifdef PURIFY +#define new_XPV() (void*)malloc(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 del_XPVIV(p) free((char*)p) + +#define new_XPVNV() (void*)malloc(sizeof(XPVNV)) +#define del_XPVNV(p) free((char*)p) + +#define new_XPVMG() (void*)malloc(sizeof(XPVMG)) +#define del_XPVMG(p) free((char*)p) + +#define new_XPVLV() (void*)malloc(sizeof(XPVLV)) +#define del_XPVLV(p) free((char*)p) + +#define new_XPVAV() (void*)malloc(sizeof(XPVAV)) +#define del_XPVAV(p) free((char*)p) + +#define new_XPVHV() (void*)malloc(sizeof(XPVHV)) +#define del_XPVHV(p) free((char*)p) + +#define new_XPVCV() (void*)malloc(sizeof(XPVCV)) +#define del_XPVCV(p) free((char*)p) + +#define new_XPVGV() (void*)malloc(sizeof(XPVGV)) +#define del_XPVGV(p) free((char*)p) + +#define new_XPVBM() (void*)malloc(sizeof(XPVBM)) +#define del_XPVBM(p) free((char*)p) + +#define new_XPVFM() (void*)malloc(sizeof(XPVFM)) +#define del_XPVFM(p) free((char*)p) + bool sv_upgrade(sv, mt) register SV* sv; @@ -81,8 +321,8 @@ U32 mt; pv = 0; cur = 0; len = 0; - iv = SvANYI32(sv); - nv = (double)SvANYI32(sv); + iv = (I32)SvANY(sv); + nv = (double)(unsigned long)SvANY(sv); SvNOK_only(sv); magic = 0; stash = 0; @@ -93,23 +333,22 @@ U32 mt; pv = 0; cur = 0; len = 0; - iv = SvIV(sv); - nv = (double)SvIV(sv); + iv = SvIVX(sv); + nv = (double)SvIVX(sv); del_XIV(SvANY(sv)); magic = 0; stash = 0; if (mt == SVt_PV) mt = SVt_PVIV; + else if (mt == SVt_NV) + mt = SVt_PVNV; break; case SVt_NV: pv = 0; cur = 0; len = 0; - if (SvIOK(sv)) - iv = SvIV(sv); - else - iv = (I32)SvNV(sv); - nv = SvNV(sv); + nv = SvNVX(sv); + iv = (I32)nv; magic = 0; stash = 0; del_XNV(SvANY(sv)); @@ -119,7 +358,7 @@ U32 mt; break; case SVt_PV: nv = 0.0; - pv = SvPV(sv); + pv = SvPVX(sv); cur = SvCUR(sv); len = SvLEN(sv); iv = 0; @@ -130,96 +369,95 @@ U32 mt; break; case SVt_PVIV: nv = 0.0; - pv = SvPV(sv); + pv = SvPVX(sv); cur = SvCUR(sv); len = SvLEN(sv); - iv = SvIV(sv); + iv = SvIVX(sv); nv = 0.0; magic = 0; stash = 0; del_XPVIV(SvANY(sv)); break; case SVt_PVNV: - nv = SvNV(sv); - pv = SvPV(sv); + nv = SvNVX(sv); + pv = SvPVX(sv); cur = SvCUR(sv); len = SvLEN(sv); - iv = SvIV(sv); - nv = SvNV(sv); + iv = SvIVX(sv); + nv = SvNVX(sv); magic = 0; stash = 0; del_XPVNV(SvANY(sv)); break; case SVt_PVMG: - pv = SvPV(sv); + pv = SvPVX(sv); cur = SvCUR(sv); len = SvLEN(sv); - iv = SvIV(sv); - nv = SvNV(sv); + iv = SvIVX(sv); + nv = SvNVX(sv); magic = SvMAGIC(sv); stash = SvSTASH(sv); del_XPVMG(SvANY(sv)); break; default: - fatal("Can't upgrade that kind of scalar"); + croak("Can't upgrade that kind of scalar"); } switch (mt) { case SVt_NULL: - fatal("Can't upgrade to undef"); + croak("Can't upgrade to undef"); case SVt_REF: - SvIOK_on(sv); + SvOK_on(sv); break; case SVt_IV: SvANY(sv) = new_XIV(); - SvIV(sv) = iv; + SvIVX(sv) = iv; break; case SVt_NV: SvANY(sv) = new_XNV(); - SvIV(sv) = iv; - SvNV(sv) = nv; + SvNVX(sv) = nv; break; case SVt_PV: SvANY(sv) = new_XPV(); - SvPV(sv) = pv; + SvPVX(sv) = pv; SvCUR(sv) = cur; SvLEN(sv) = len; break; case SVt_PVIV: SvANY(sv) = new_XPVIV(); - SvPV(sv) = pv; + SvPVX(sv) = pv; SvCUR(sv) = cur; SvLEN(sv) = len; - SvIV(sv) = iv; + SvIVX(sv) = iv; if (SvNIOK(sv)) SvIOK_on(sv); SvNOK_off(sv); break; case SVt_PVNV: SvANY(sv) = new_XPVNV(); - SvPV(sv) = pv; + SvPVX(sv) = pv; SvCUR(sv) = cur; SvLEN(sv) = len; - SvIV(sv) = iv; - SvNV(sv) = nv; + SvIVX(sv) = iv; + SvNVX(sv) = nv; break; case SVt_PVMG: SvANY(sv) = new_XPVMG(); - SvPV(sv) = pv; + SvPVX(sv) = pv; SvCUR(sv) = cur; SvLEN(sv) = len; - SvIV(sv) = iv; - SvNV(sv) = nv; + SvIVX(sv) = iv; + SvNVX(sv) = nv; SvMAGIC(sv) = magic; SvSTASH(sv) = stash; break; case SVt_PVLV: SvANY(sv) = new_XPVLV(); - SvPV(sv) = pv; + SvPVX(sv) = pv; SvCUR(sv) = cur; SvLEN(sv) = len; - SvIV(sv) = iv; - SvNV(sv) = nv; + SvIVX(sv) = iv; + SvNVX(sv) = nv; SvMAGIC(sv) = magic; SvSTASH(sv) = stash; LvTARGOFF(sv) = 0; @@ -229,49 +467,42 @@ U32 mt; break; case SVt_PVAV: SvANY(sv) = new_XPVAV(); - SvPV(sv) = pv; - SvCUR(sv) = cur; - SvLEN(sv) = len; - SvIV(sv) = iv; - SvNV(sv) = nv; - SvMAGIC(sv) = magic; - SvSTASH(sv) = stash; - AvMAGIC(sv) = 0; + if (pv) + Safefree(pv); AvARRAY(sv) = 0; - AvALLOC(sv) = 0; AvMAX(sv) = 0; AvFILL(sv) = 0; + SvIVX(sv) = 0; + SvNVX(sv) = 0.0; + SvMAGIC(sv) = magic; + SvSTASH(sv) = stash; + AvALLOC(sv) = 0; AvARYLEN(sv) = 0; AvFLAGS(sv) = 0; break; case SVt_PVHV: SvANY(sv) = new_XPVHV(); - SvPV(sv) = pv; - SvCUR(sv) = cur; - SvLEN(sv) = len; - SvIV(sv) = iv; - SvNV(sv) = nv; + if (pv) + Safefree(pv); + SvPVX(sv) = 0; + HvFILL(sv) = 0; + HvMAX(sv) = 0; + HvKEYS(sv) = 0; + SvNVX(sv) = 0.0; SvMAGIC(sv) = magic; SvSTASH(sv) = stash; - HvMAGIC(sv) = 0; - HvARRAY(sv) = 0; - HvMAX(sv) = 0; - HvDOSPLIT(sv) = 0; - HvFILL(sv) = 0; HvRITER(sv) = 0; HvEITER(sv) = 0; HvPMROOT(sv) = 0; HvNAME(sv) = 0; - HvDBM(sv) = 0; - HvCOEFFSIZE(sv) = 0; break; case SVt_PVCV: SvANY(sv) = new_XPVCV(); - SvPV(sv) = pv; + SvPVX(sv) = pv; SvCUR(sv) = cur; SvLEN(sv) = len; - SvIV(sv) = iv; - SvNV(sv) = nv; + SvIVX(sv) = iv; + SvNVX(sv) = nv; SvMAGIC(sv) = magic; SvSTASH(sv) = stash; CvSTASH(sv) = 0; @@ -286,11 +517,11 @@ U32 mt; break; case SVt_PVGV: SvANY(sv) = new_XPVGV(); - SvPV(sv) = pv; + SvPVX(sv) = pv; SvCUR(sv) = cur; SvLEN(sv) = len; - SvIV(sv) = iv; - SvNV(sv) = nv; + SvIVX(sv) = iv; + SvNVX(sv) = nv; SvMAGIC(sv) = magic; SvSTASH(sv) = stash; GvGP(sv) = 0; @@ -300,11 +531,11 @@ U32 mt; break; case SVt_PVBM: SvANY(sv) = new_XPVBM(); - SvPV(sv) = pv; + SvPVX(sv) = pv; SvCUR(sv) = cur; SvLEN(sv) = len; - SvIV(sv) = iv; - SvNV(sv) = nv; + SvIVX(sv) = iv; + SvNVX(sv) = nv; SvMAGIC(sv) = magic; SvSTASH(sv) = stash; BmRARE(sv) = 0; @@ -313,11 +544,11 @@ U32 mt; break; case SVt_PVFM: SvANY(sv) = new_XPVFM(); - SvPV(sv) = pv; + SvPVX(sv) = pv; SvCUR(sv) = cur; SvLEN(sv) = len; - SvIV(sv) = iv; - SvNV(sv) = nv; + SvIVX(sv) = iv; + SvNVX(sv) = nv; SvMAGIC(sv) = magic; SvSTASH(sv) = stash; FmLINES(sv) = 0; @@ -409,17 +640,17 @@ register SV *sv; t += strlen(t); if (SvPOK(sv)) { - if (!SvPV(sv)) + if (!SvPVX(sv)) return "(null)"; if (SvOOK(sv)) - sprintf(t,"(%d+\"%0.127s\")",SvIV(sv),SvPV(sv)); + sprintf(t,"(%d+\"%0.127s\")",SvIVX(sv),SvPVX(sv)); else - sprintf(t,"(\"%0.127s\")",SvPV(sv)); + sprintf(t,"(\"%0.127s\")",SvPVX(sv)); } else if (SvNOK(sv)) - sprintf(t,"(%g)",SvNV(sv)); + sprintf(t,"(%g)",SvNVX(sv)); else if (SvIOK(sv)) - sprintf(t,"(%ld)",(long)SvIV(sv)); + sprintf(t,"(%ld)",(long)SvIVX(sv)); else strcpy(t,"()"); return tokenbuf; @@ -430,12 +661,12 @@ sv_backoff(sv) register SV *sv; { assert(SvOOK(sv)); - if (SvIV(sv)) { - char *s = SvPV(sv); - SvLEN(sv) += SvIV(sv); - SvPV(sv) -= SvIV(sv); + if (SvIVX(sv)) { + char *s = SvPVX(sv); + SvLEN(sv) += SvIVX(sv); + SvPVX(sv) -= SvIVX(sv); SvIV_set(sv, 0); - Move(s, SvPV(sv), SvCUR(sv)+1, char); + Move(s, SvPVX(sv), SvCUR(sv)+1, char); } SvFLAGS(sv) &= ~SVf_OOK; } @@ -458,19 +689,19 @@ unsigned long newlen; } #endif /* MSDOS */ if (SvREADONLY(sv)) - fatal(no_modify); + croak(no_modify); if (SvTYPE(sv) < SVt_PV) { sv_upgrade(sv, SVt_PV); - s = SvPV(sv); + s = SvPVX(sv); } else if (SvOOK(sv)) { /* pv is offset? */ sv_backoff(sv); - s = SvPV(sv); + s = SvPVX(sv); if (newlen > SvLEN(sv)) newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */ } else - s = SvPV(sv); + s = SvPVX(sv); if (newlen > SvLEN(sv)) { /* need more room? */ if (SvLEN(sv)) Renew(s,newlen,char); @@ -488,14 +719,22 @@ register SV *sv; I32 i; { if (SvREADONLY(sv)) - fatal(no_modify); - if (SvTYPE(sv) < SVt_IV) + croak(no_modify); + switch (SvTYPE(sv)) { + case SVt_NULL: + case SVt_REF: sv_upgrade(sv, SVt_IV); - else if (SvTYPE(sv) == SVt_PV) + break; + case SVt_NV: + sv_upgrade(sv, SVt_PVNV); + break; + case SVt_PV: sv_upgrade(sv, SVt_PVIV); - SvIV(sv) = i; + break; + } + SvIVX(sv) = i; SvIOK_only(sv); /* validate number */ - SvTDOWN(sv); + SvTAINT(sv); } void @@ -504,7 +743,7 @@ register SV *sv; double num; { if (SvREADONLY(sv)) - fatal(no_modify); + croak(no_modify); if (SvTYPE(sv) < SVt_NV) sv_upgrade(sv, SVt_NV); else if (SvTYPE(sv) < SVt_PVNV) @@ -512,9 +751,9 @@ double num; else if (SvPOK(sv)) { SvOOK_off(sv); } - SvNV(sv) = num; + SvNVX(sv) = num; SvNOK_only(sv); /* validate number */ - SvTDOWN(sv); + SvTAINT(sv); } I32 @@ -523,26 +762,40 @@ register SV *sv; { if (!sv) return 0; + if (SvMAGICAL(sv)) { + mg_get(sv); + if (SvIOKp(sv)) + return SvIVX(sv); + if (SvNOKp(sv)) + return (I32)SvNVX(sv); + if (SvPOKp(sv) && SvLEN(sv)) + return (I32)atol(SvPVX(sv)); + return 0; + } if (SvREADONLY(sv)) { if (SvNOK(sv)) - return (I32)SvNV(sv); + return (I32)SvNVX(sv); if (SvPOK(sv) && SvLEN(sv)) - return atof(SvPV(sv)); + return (I32)atol(SvPVX(sv)); if (dowarn) warn("Use of uninitialized variable"); return 0; } - if (SvTYPE(sv) < SVt_IV) { - if (SvTYPE(sv) == SVt_REF) - return (I32)SvANYI32(sv); + switch (SvTYPE(sv)) { + case SVt_REF: + return (I32)SvANY(sv); + case SVt_NULL: sv_upgrade(sv, SVt_IV); - DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvIV(sv))); - return SvIV(sv); - } - else if (SvTYPE(sv) == SVt_PV) + return SvIVX(sv); + case SVt_PV: sv_upgrade(sv, SVt_PVIV); + break; + case SVt_NV: + sv_upgrade(sv, SVt_PVNV); + break; + } if (SvNOK(sv)) - SvIV(sv) = (I32)SvNV(sv); + SvIVX(sv) = (I32)SvNVX(sv); else if (SvPOK(sv) && SvLEN(sv)) { if (dowarn && !looks_like_number(sv)) { if (op) @@ -550,17 +803,17 @@ register SV *sv; else warn("Argument wasn't numeric"); } - SvIV(sv) = atol(SvPV(sv)); + SvIVX(sv) = (I32)atol(SvPVX(sv)); } else { if (dowarn) warn("Use of uninitialized variable"); SvUPGRADE(sv, SVt_IV); - SvIV(sv) = 0; + SvIVX(sv) = 0; } SvIOK_on(sv); - DEBUG_c((stderr,"0x%lx 2iv(%d)\n",sv,SvIV(sv))); - return SvIV(sv); + DEBUG_c((stderr,"0x%lx 2iv(%d)\n",sv,SvIVX(sv))); + return SvIVX(sv); } double @@ -569,26 +822,39 @@ register SV *sv; { if (!sv) return 0.0; + if (SvMAGICAL(sv)) { + mg_get(sv); + if (SvNOKp(sv)) + return SvNVX(sv); + if (SvPOKp(sv) && SvLEN(sv)) + return atof(SvPVX(sv)); + if (SvIOKp(sv)) + return (double)SvIVX(sv); + return 0; + } if (SvREADONLY(sv)) { if (SvPOK(sv) && SvLEN(sv)) - return atof(SvPV(sv)); + return atof(SvPVX(sv)); if (dowarn) warn("Use of uninitialized variable"); return 0.0; } if (SvTYPE(sv) < SVt_NV) { if (SvTYPE(sv) == SVt_REF) - return (double)SvANYI32(sv); - sv_upgrade(sv, SVt_NV); - DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvNV(sv))); - return SvNV(sv); + return (double)(unsigned long)SvANY(sv); + if (SvTYPE(sv) == SVt_IV) + sv_upgrade(sv, SVt_PVNV); + 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); if (SvIOK(sv) && - (!SvPOK(sv) || !strchr(SvPV(sv),'.') || !looks_like_number(sv))) + (!SvPOK(sv) || !strchr(SvPVX(sv),'.') || !looks_like_number(sv))) { - SvNV(sv) = (double)SvIV(sv); + SvNVX(sv) = (double)SvIVX(sv); } else if (SvPOK(sv) && SvLEN(sv)) { if (dowarn && !SvIOK(sv) && !looks_like_number(sv)) { @@ -597,63 +863,96 @@ register SV *sv; else warn("Argument wasn't numeric"); } - SvNV(sv) = atof(SvPV(sv)); + SvNVX(sv) = atof(SvPVX(sv)); } else { if (dowarn) warn("Use of uninitialized variable"); - SvNV(sv) = 0.0; + SvNVX(sv) = 0.0; } SvNOK_on(sv); - DEBUG_c((stderr,"0x%lx 2nv(%g)\n",sv,SvNV(sv))); - return SvNV(sv); + DEBUG_c((stderr,"0x%lx 2nv(%g)\n",sv,SvNVX(sv))); + return SvNVX(sv); } char * -sv_2pv(sv) +sv_2pv(sv, lp) register SV *sv; +STRLEN *lp; { register char *s; int olderrno; - if (!sv) + if (!sv) { + *lp = 0; + return ""; + } + if (SvMAGICAL(sv)) { + mg_get(sv); + if (SvPOKp(sv)) { + *lp = SvCUR(sv); + return SvPVX(sv); + } + if (SvIOKp(sv)) { + (void)sprintf(tokenbuf,"%ld",SvIVX(sv)); + *lp = strlen(tokenbuf); + return tokenbuf; + } + if (SvNOKp(sv)) { + (void)sprintf(tokenbuf,"%.20g",SvNVX(sv)); + *lp = strlen(tokenbuf); + return tokenbuf; + } + *lp = 0; return ""; + } if (SvTYPE(sv) == SVt_REF) { sv = (SV*)SvANY(sv); if (!sv) - return "<Empty reference>"; - switch (SvTYPE(sv)) { - case SVt_NULL: s = "an undefined value"; break; - case SVt_REF: s = "a reference"; break; - case SVt_IV: s = "an integer value"; break; - case SVt_NV: s = "a numeric value"; break; - case SVt_PV: s = "a string value"; break; - case SVt_PVIV: s = "a string+integer value"; break; - case SVt_PVNV: s = "a scalar value"; break; - case SVt_PVMG: s = "a magic value"; break; - case SVt_PVLV: s = "an lvalue"; break; - case SVt_PVAV: s = "an array value"; break; - case SVt_PVHV: s = "an associative array value"; break; - case SVt_PVCV: s = "a code value"; break; - case SVt_PVGV: s = "a glob value"; break; - case SVt_PVBM: s = "a search string"; break; - case SVt_PVFM: s = "a formatline"; break; - default: s = "something weird"; break; + s = "NULLREF"; + else { + switch (SvTYPE(sv)) { + case SVt_NULL: + case SVt_REF: + case SVt_IV: + case SVt_NV: + case SVt_PV: + case SVt_PVIV: + case SVt_PVNV: + case SVt_PVMG: s = "SCALAR"; break; + case SVt_PVLV: s = "LVALUE"; break; + case SVt_PVAV: s = "ARRAY"; break; + case SVt_PVHV: s = "HASH"; break; + case SVt_PVCV: s = "CODE"; break; + case SVt_PVGV: s = "GLOB"; break; + case SVt_PVBM: s = "SEARCHSTRING"; break; + case SVt_PVFM: s = "FORMATLINE"; break; + default: s = "UNKNOWN"; break; + } + if (SvSTORAGE(sv) == 'O') + sprintf(tokenbuf, "%s=%s(0x%lx)", + HvNAME(SvSTASH(sv)), s, (unsigned long)sv); + else + sprintf(tokenbuf, "%s(0x%lx)", s, (unsigned long)sv); + s = tokenbuf; } - sprintf(tokenbuf,"<Reference to %s at 0x%lx>", s, (unsigned long)sv); - return tokenbuf; + *lp = strlen(s); + return s; } if (SvREADONLY(sv)) { if (SvIOK(sv)) { - (void)sprintf(tokenbuf,"%ld",SvIV(sv)); + (void)sprintf(tokenbuf,"%ld",SvIVX(sv)); + *lp = strlen(tokenbuf); return tokenbuf; } if (SvNOK(sv)) { - (void)sprintf(tokenbuf,"%.20g",SvNV(sv)); + (void)sprintf(tokenbuf,"%.20g",SvNVX(sv)); + *lp = strlen(tokenbuf); return tokenbuf; } if (dowarn) warn("Use of uninitialized variable"); + *lp = 0; return ""; } if (!SvUPGRADE(sv, SVt_PV)) @@ -662,17 +961,17 @@ register SV *sv; if (SvTYPE(sv) < SVt_PVNV) sv_upgrade(sv, SVt_PVNV); SvGROW(sv, 28); - s = SvPV(sv); + s = SvPVX(sv); olderrno = errno; /* some Xenix systems wipe out errno here */ #if defined(scs) && defined(ns32000) - gcvt(SvNV(sv),20,s); + gcvt(SvNVX(sv),20,s); #else #ifdef apollo - if (SvNV(sv) == 0.0) + if (SvNVX(sv) == 0.0) (void)strcpy(s,"0"); else #endif /*apollo*/ - (void)sprintf(s,"%.20g",SvNV(sv)); + (void)sprintf(s,"%.20g",SvNVX(sv)); #endif /*scs*/ errno = olderrno; while (*s) s++; @@ -685,9 +984,9 @@ register SV *sv; if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv, SVt_PVIV); SvGROW(sv, 11); - s = SvPV(sv); + s = SvPVX(sv); olderrno = errno; /* some Xenix systems wipe out errno here */ - (void)sprintf(s,"%ld",SvIV(sv)); + (void)sprintf(s,"%ld",SvIVX(sv)); errno = olderrno; while (*s) s++; } @@ -695,17 +994,50 @@ register SV *sv; if (dowarn) warn("Use of uninitialized variable"); sv_grow(sv, 1); - s = SvPV(sv); + s = SvPVX(sv); } *s = '\0'; - SvCUR_set(sv, s - SvPV(sv)); + *lp = s - SvPVX(sv); + SvCUR_set(sv, *lp); SvPOK_on(sv); - DEBUG_c((stderr,"0x%lx 2pv(%s)\n",sv,SvPV(sv))); - return SvPV(sv); + DEBUG_c((stderr,"0x%lx 2pv(%s)\n",sv,SvPVX(sv))); + return SvPVX(sv); +} + +/* This function is only called on magical items */ +bool +sv_2bool(sv) +register SV *sv; +{ + if (SvMAGICAL(sv)) + mg_get(sv); + + if (SvTYPE(sv) == SVt_REF) + return SvANY(sv) != 0; + if (SvPOKp(sv)) { + register XPV* Xpv; + if ((Xpv = (XPV*)SvANY(sv)) && + (*Xpv->xpv_pv > '0' || + Xpv->xpv_cur > 1 || + (Xpv->xpv_cur && *Xpv->xpv_pv != '0'))) + return 1; + else + return 0; + } + else { + if (SvIOKp(sv)) + return SvIVX(sv) != 0; + else { + if (SvNOKp(sv)) + return SvNVX(sv) != 0.0; + else + return FALSE; + } + } } /* Note: sv_setsv() should not be called with a source string that needs - * be reused, since it may destroy the source string if it is marked + * to be reused, since it may destroy the source string if it is marked * as temporary. */ @@ -714,23 +1046,16 @@ sv_setsv(dstr,sstr) SV *dstr; register SV *sstr; { + int flags; + if (sstr == dstr) return; if (SvREADONLY(dstr)) - fatal(no_modify); + croak(no_modify); if (!sstr) sstr = &sv_undef; - if (SvTYPE(dstr) < SvTYPE(sstr)) - sv_upgrade(dstr, SvTYPE(sstr)); - else if (SvTYPE(dstr) == SVt_PV && SvTYPE(sstr) <= SVt_NV) { - if (SvTYPE(sstr) <= SVt_IV) - sv_upgrade(dstr, SVt_PVIV); /* handle discontinuities */ - else - sv_upgrade(dstr, SVt_PVNV); - } - else if (SvTYPE(dstr) == SVt_PVIV && SvTYPE(sstr) == SVt_NV) - sv_upgrade(dstr, SVt_PVNV); + /* There's a lot of redundancy below but we're going for speed here */ switch (SvTYPE(sstr)) { case SVt_NULL: @@ -743,23 +1068,63 @@ register SV *sstr; SvOK_off(dstr); return; case SVt_REF: - SvTUP(sstr); + if (SvTYPE(dstr) < SVt_REF) + sv_upgrade(dstr, SVt_REF); if (SvTYPE(dstr) == SVt_REF) { + sv_free((SV*)SvANY(dstr)); + SvANY(dstr) = 0; SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr)); } else { if (SvMAGICAL(dstr)) - fatal("Can't assign a reference to a magical variable"); + croak("Can't assign a reference to a magical variable"); + if (SvREFCNT(dstr) != 1) + warn("Reference miscount in sv_setsv()"); + SvREFCNT(dstr) = 0; sv_clear(dstr); SvTYPE(dstr) = SVt_REF; SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr)); SvOK_off(dstr); } - SvTDOWN(sstr); + SvTAINT(sstr); 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); + 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); + break; + case SVt_PV: + if (SvTYPE(dstr) < SVt_PV) + sv_upgrade(dstr, SVt_PV); + flags = SvFLAGS(sstr); + break; + case SVt_PVIV: + if (SvTYPE(dstr) < SVt_PVIV) + sv_upgrade(dstr, SVt_PVIV); + flags = SvFLAGS(sstr); + break; + case SVt_PVNV: + if (SvTYPE(dstr) < SVt_PVNV) + sv_upgrade(dstr, SVt_PVNV); + flags = SvFLAGS(sstr); + break; case SVt_PVGV: - SvTUP(sstr); - if (SvTYPE(dstr) == SVt_PVGV) { + if (SvTYPE(dstr) <= SVt_PVGV) { + if (SvTYPE(dstr) < SVt_PVGV) + sv_upgrade(dstr, SVt_PVGV); SvOK_off(dstr); if (!GvAV(sstr)) gv_AVadd(sstr); @@ -770,83 +1135,81 @@ register SV *sstr; if (GvGP(dstr)) gp_free(dstr); GvGP(dstr) = gp_ref(GvGP(sstr)); - SvTDOWN(sstr); + SvTAINT(sstr); return; } /* FALL THROUGH */ default: - if (SvMAGICAL(sstr)) + if (SvTYPE(dstr) < SvTYPE(sstr)) + sv_upgrade(dstr, SvTYPE(sstr)); + if (SvMAGICAL(sstr)) { mg_get(sstr); - /* XXX */ - break; + flags = SvPRIVATE(sstr); + } + else + flags = SvFLAGS(sstr); } - SvPRIVATE(dstr) = SvPRIVATE(sstr); - SvSTORAGE(dstr) = SvSTORAGE(sstr); - if (SvPOK(sstr)) { + SvPRIVATE(dstr) = SvPRIVATE(sstr) & ~(SVf_IOK|SVf_POK|SVf_NOK); - SvTUP(sstr); + if (flags & SVf_POK) { /* * Check to see if we can just swipe the string. If so, it's a * possible small lose on short strings, but a big win on long ones. - * It might even be a win on short strings if SvPV(dstr) - * has to be allocated and SvPV(sstr) has to be freed. + * It might even be a win on short strings if SvPVX(dstr) + * has to be allocated and SvPVX(sstr) has to be freed. */ if (SvTEMP(sstr)) { /* slated for free anyway? */ if (SvPOK(dstr)) { SvOOK_off(dstr); - Safefree(SvPV(dstr)); + Safefree(SvPVX(dstr)); } - SvPV_set(dstr, SvPV(sstr)); + SvPV_set(dstr, SvPVX(sstr)); SvLEN_set(dstr, SvLEN(sstr)); SvCUR_set(dstr, SvCUR(sstr)); - SvTYPE(dstr) = SvTYPE(sstr); SvPOK_only(dstr); SvTEMP_off(dstr); SvPV_set(sstr, Nullch); SvLEN_set(sstr, 0); SvPOK_off(sstr); /* wipe out any weird flags */ - SvTYPE(sstr) = 0; /* so sstr frees uneventfully */ + SvPVX(sstr) = 0; /* so sstr frees uneventfully */ } else { /* have to copy actual string */ - if (SvPV(dstr)) { /* XXX ck type */ + if (SvPVX(dstr)) { /* XXX ck type */ SvOOK_off(dstr); } - sv_setpvn(dstr,SvPV(sstr),SvCUR(sstr)); + sv_setpvn(dstr,SvPVX(sstr),SvCUR(sstr)); } /*SUPPRESS 560*/ - if (SvNOK(sstr)) { + if (flags & SVf_NOK) { SvNOK_on(dstr); - SvNV(dstr) = SvNV(sstr); + SvNVX(dstr) = SvNVX(sstr); } - if (SvIOK(sstr)) { + if (flags & SVf_IOK) { SvIOK_on(dstr); - SvIV(dstr) = SvIV(sstr); + SvIVX(dstr) = SvIVX(sstr); } } - else if (SvNOK(sstr)) { - SvTUP(sstr); - SvNV(dstr) = SvNV(sstr); + else if (flags & SVf_NOK) { + SvNVX(dstr) = SvNVX(sstr); SvNOK_only(dstr); if (SvIOK(sstr)) { SvIOK_on(dstr); - SvIV(dstr) = SvIV(sstr); + SvIVX(dstr) = SvIVX(sstr); } } - else if (SvIOK(sstr)) { - SvTUP(sstr); + else if (flags & SVf_IOK) { SvIOK_only(dstr); - SvIV(dstr) = SvIV(sstr); + SvIVX(dstr) = SvIVX(sstr); } else { - SvTUP(sstr); SvOK_off(dstr); } - SvTDOWN(dstr); + SvTAINT(dstr); } void @@ -855,15 +1218,21 @@ register SV *sv; register char *ptr; register STRLEN len; { + if (SvREADONLY(sv)) + croak(no_modify); + if (!ptr) { + SvOK_off(sv); + return; + } if (!SvUPGRADE(sv, SVt_PV)) return; SvGROW(sv, len + 1); if (ptr) - Move(ptr,SvPV(sv),len,char); + Move(ptr,SvPVX(sv),len,char); SvCUR_set(sv, len); *SvEND(sv) = '\0'; SvPOK_only(sv); /* validate pointer */ - SvTDOWN(sv); + SvTAINT(sv); } void @@ -874,17 +1243,44 @@ register char *ptr; register STRLEN len; if (SvREADONLY(sv)) - fatal(no_modify); - if (!ptr) - ptr = ""; + croak(no_modify); + if (!ptr) { + SvOK_off(sv); + return; + } len = strlen(ptr); if (!SvUPGRADE(sv, SVt_PV)) return; SvGROW(sv, len + 1); - Move(ptr,SvPV(sv),len+1,char); + Move(ptr,SvPVX(sv),len+1,char); SvCUR_set(sv, len); SvPOK_only(sv); /* validate pointer */ - SvTDOWN(sv); + SvTAINT(sv); +} + +void +sv_usepvn(sv,ptr,len) +register SV *sv; +register char *ptr; +register STRLEN len; +{ + if (SvREADONLY(sv)) + croak(no_modify); + if (!SvUPGRADE(sv, SVt_PV)) + return; + if (!ptr) { + SvOK_off(sv); + return; + } + if (SvPVX(sv)) + Safefree(SvPVX(sv)); + Renew(ptr, len+1, char); + SvPVX(sv) = ptr; + SvCUR_set(sv, len); + SvLEN_set(sv, len+1); + *SvEND(sv) = '\0'; + SvPOK_only(sv); /* validate pointer */ + SvTAINT(sv); } void @@ -897,20 +1293,20 @@ register char *ptr; if (!ptr || !SvPOK(sv)) return; if (SvREADONLY(sv)) - fatal(no_modify); + croak(no_modify); if (SvTYPE(sv) < SVt_PVIV) sv_upgrade(sv,SVt_PVIV); if (!SvOOK(sv)) { - SvIV(sv) = 0; + SvIVX(sv) = 0; SvFLAGS(sv) |= SVf_OOK; } SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK); - delta = ptr - SvPV(sv); + delta = ptr - SvPVX(sv); SvLEN(sv) -= delta; SvCUR(sv) -= delta; - SvPV(sv) += delta; - SvIV(sv) += delta; + SvPVX(sv) += delta; + SvIVX(sv) += delta; } void @@ -919,16 +1315,17 @@ register SV *sv; register char *ptr; register STRLEN len; { + STRLEN tlen; + char *s; if (SvREADONLY(sv)) - fatal(no_modify); - if (!(SvPOK(sv))) - (void)sv_2pv(sv); - SvGROW(sv, SvCUR(sv) + len + 1); - Move(ptr,SvPV(sv)+SvCUR(sv),len,char); + croak(no_modify); + s = SvPV(sv, tlen); + SvGROW(sv, tlen + len + 1); + Move(ptr,SvPVX(sv)+tlen,len,char); SvCUR(sv) += len; *SvEND(sv) = '\0'; SvPOK_only(sv); /* validate pointer */ - SvTDOWN(sv); + SvTAINT(sv); } void @@ -937,14 +1334,11 @@ SV *dstr; register SV *sstr; { char *s; + STRLEN len; if (!sstr) return; - if (s = SvPVn(sstr)) { - if (SvPOK(sstr)) - sv_catpvn(dstr,s,SvCUR(sstr)); - else - sv_catpv(dstr,s); - } + if (s = SvPV(sstr, len)) + sv_catpvn(dstr,s,len); } void @@ -953,19 +1347,20 @@ register SV *sv; register char *ptr; { register STRLEN len; + STRLEN tlen; + char *s; if (SvREADONLY(sv)) - fatal(no_modify); + croak(no_modify); if (!ptr) return; - if (!(SvPOK(sv))) - (void)sv_2pv(sv); + s = SvPV(sv, tlen); len = strlen(ptr); - SvGROW(sv, SvCUR(sv) + len + 1); - Move(ptr,SvPV(sv)+SvCUR(sv),len+1,char); + SvGROW(sv, tlen + len + 1); + Move(ptr,SvPVX(sv)+tlen,len+1,char); SvCUR(sv) += len; SvPOK_only(sv); /* validate pointer */ - SvTDOWN(sv); + SvTAINT(sv); } SV * @@ -979,7 +1374,7 @@ STRLEN len; { register SV *sv; - sv = (SV*)new_SV(); + new_SV(); Zero(sv, 1, SV); SvREFCNT(sv)++; if (len) { @@ -995,24 +1390,33 @@ register SV *sv; SV *obj; char how; char *name; -STRLEN namlen; +I32 namlen; { MAGIC* mg; if (SvREADONLY(sv)) - fatal(no_modify); - if (!SvUPGRADE(sv, SVt_PVMG)) - return; + croak(no_modify); + if (SvMAGICAL(sv)) { + if (SvMAGIC(sv) && mg_find(sv, how)) + return; + } + 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); - SvMAGICAL_on(sv); + SvMAGIC(sv) = mg; - mg->mg_obj = obj; + mg->mg_obj = sv_ref(obj); mg->mg_type = how; - if (name) { + mg->mg_len = namlen; + if (name && namlen >= 0) mg->mg_ptr = nsavestr(name, namlen); - mg->mg_len = namlen; - } switch (how) { case 0: mg->mg_virtual = &vtbl_sv; @@ -1020,12 +1424,6 @@ STRLEN namlen; case 'B': mg->mg_virtual = &vtbl_bm; break; - case 'D': - mg->mg_virtual = &vtbl_dbm; - break; - case 'd': - mg->mg_virtual = &vtbl_dbmelem; - break; case 'E': mg->mg_virtual = &vtbl_env; break; @@ -1035,18 +1433,33 @@ STRLEN namlen; case 'g': mg->mg_virtual = &vtbl_mglob; break; + case 'I': + mg->mg_virtual = &vtbl_isa; + break; + case 'i': + mg->mg_virtual = &vtbl_isaelem; + break; case 'L': mg->mg_virtual = 0; break; case 'l': mg->mg_virtual = &vtbl_dbline; break; + case 'P': + mg->mg_virtual = &vtbl_pack; + break; + case 'p': + mg->mg_virtual = &vtbl_packelem; + break; case 'S': mg->mg_virtual = &vtbl_sig; break; case 's': mg->mg_virtual = &vtbl_sigelem; break; + case 't': + mg->mg_virtual = &vtbl_taint; + break; case 'U': mg->mg_virtual = &vtbl_uvar; break; @@ -1063,8 +1476,42 @@ STRLEN namlen; mg->mg_virtual = &vtbl_arylen; break; default: - fatal("Don't know how to handle magic of type '%c'", how); + croak("Don't know how to handle magic of type '%c'", how); + } +} + +int +sv_unmagic(sv, type) +SV* sv; +char type; +{ + MAGIC* mg; + MAGIC** mgp; + if (!SvMAGICAL(sv)) + return 0; + mgp = &SvMAGIC(sv); + for (mg = *mgp; mg; mg = *mgp) { + if (mg->mg_type == type) { + MGVTBL* vtbl = mg->mg_virtual; + *mgp = mg->mg_moremagic; + if (vtbl && vtbl->svt_free) + (*vtbl->svt_free)(sv, mg); + if (mg->mg_ptr && mg->mg_type != 'g') + Safefree(mg->mg_ptr); + sv_free(mg->mg_obj); + Safefree(mg); + } + else + mgp = &mg->mg_moremagic; } + 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); + } + + return 0; } void @@ -1082,7 +1529,7 @@ STRLEN littlelen; register I32 i; if (SvREADONLY(bigstr)) - fatal(no_modify); + croak(no_modify); SvPOK_only(bigstr); i = littlelen - len; @@ -1090,7 +1537,7 @@ STRLEN littlelen; if (!SvUPGRADE(bigstr, SVt_PV)) return; SvGROW(bigstr, SvCUR(bigstr) + i + 1); - big = SvPV(bigstr); + big = SvPVX(bigstr); mid = big + offset + len; midend = bigend = big + SvCUR(bigstr); bigend += i; @@ -1103,18 +1550,18 @@ STRLEN littlelen; return; } else if (i == 0) { - Move(little,SvPV(bigstr)+offset,len,char); + Move(little,SvPVX(bigstr)+offset,len,char); SvSETMAGIC(bigstr); return; } - big = SvPV(bigstr); + big = SvPVX(bigstr); mid = big + offset; midend = mid + len; bigend = big + SvCUR(bigstr); if (midend > bigend) - fatal("panic: sv_insert"); + croak("panic: sv_insert"); if (mid - big > bigend - midend) { /* faster to shorten from end */ if (littlelen) { @@ -1160,7 +1607,7 @@ register SV *nsv; { U32 refcnt = SvREFCNT(sv); if (SvREADONLY(sv)) - fatal(no_modify); + croak(no_modify); if (SvREFCNT(nsv) != 1) warn("Reference miscount in sv_replace()"); if (SvMAGICAL(sv)) { @@ -1174,7 +1621,7 @@ register SV *nsv; sv_clear(sv); StructCopy(nsv,sv,SV); SvREFCNT(sv) = refcnt; - Safefree(nsv); + del_SV(nsv); } void @@ -1184,6 +1631,47 @@ register SV *sv; assert(sv); assert(SvREFCNT(sv) == 0); + if (SvSTORAGE(sv) == 'O') { + dSP; + BINOP myop; /* fake syntax tree node */ + GV* destructor; + + SvSTORAGE(sv) = 0; /* Curse the object. */ + + ENTER; + SAVETMPS; + SAVESPTR(curcop); + SAVESPTR(op); + curcop = &compiling; + curstash = SvSTASH(sv); + destructor = gv_fetchpv("DESTROY", FALSE); + + if (destructor && GvCV(destructor)) { + SV* ref = sv_mortalcopy(&sv_undef); + sv_upgrade(ref, SVt_REF); + SvANY(ref) = (void*)sv_ref(sv); + + op = (OP*)&myop; + Zero(op, 1, OP); + myop.op_last = (OP*)&myop; + myop.op_flags = OPf_STACKED; + myop.op_next = Nullop; + + EXTEND(SP, 2); + PUSHs((SV*)destructor); + pp_pushmark(); + PUSHs(ref); + PUTBACK; + op = pp_entersubr(); + if (op) + run(); + stack_sp--; + SvREFCNT(sv) = 0; + SvTYPE(ref) = SVt_NULL; + free_tmps(); + } + LEAVE; + } switch (SvTYPE(sv)) { case SVt_PVFM: goto freemagic; @@ -1193,27 +1681,27 @@ register SV *sv; gp_free(sv); goto freemagic; case SVt_PVCV: - op_free(CvSTART(sv)); + cv_clear((CV*)sv); goto freemagic; case SVt_PVHV: - hv_clear(sv, FALSE); + hv_clear((HV*)sv); goto freemagic; case SVt_PVAV: - av_clear(sv); + av_clear((AV*)sv); goto freemagic; case SVt_PVLV: goto freemagic; case SVt_PVMG: freemagic: if (SvMAGICAL(sv)) - mg_freeall(sv); + mg_free(sv); case SVt_PVNV: case SVt_PVIV: SvOOK_off(sv); /* FALL THROUGH */ case SVt_PV: - if (SvPV(sv)) - Safefree(SvPV(sv)); + if (SvPVX(sv)) + Safefree(SvPVX(sv)); break; case SVt_NV: break; @@ -1278,7 +1766,8 @@ SV * sv_ref(sv) SV* sv; { - SvREFCNT(sv)++; + if (sv) + SvREFCNT(sv)++; return sv; } @@ -1296,47 +1785,14 @@ SV *sv; warn("Attempt to free unreferenced scalar"); return; } - if (--SvREFCNT(sv) > 0) +#ifdef DEBUGGING + if (SvTEMP(sv)) { + warn("Attempt to free temp prematurely"); return; - if (SvSTORAGE(sv) == 'O') { - dSP; - BINOP myop; /* fake syntax tree node */ - GV* destructor; - - SvSTORAGE(sv) = 0; /* Curse the object. */ - - ENTER; - SAVESPTR(curcop); - SAVESPTR(op); - curcop = &compiling; - curstash = SvSTASH(sv); - destructor = gv_fetchpv("DESTROY", FALSE); - - if (GvCV(destructor)) { - SV* ref = sv_mortalcopy(&sv_undef); - SvREFCNT(ref) = 1; - sv_upgrade(ref, SVt_REF); - SvANY(ref) = (void*)sv_ref(sv); - - op = (OP*)&myop; - Zero(op, 1, OP); - myop.op_last = (OP*)&myop; - myop.op_flags = OPf_STACKED; - myop.op_next = Nullop; - - EXTEND(SP, 2); - PUSHs((SV*)destructor); - pp_pushmark(); - PUSHs(ref); - PUTBACK; - op = pp_entersubr(); - run(); - stack_sp--; - LEAVE; /* Will eventually free sv as ordinary item. */ - return; - } - LEAVE; } +#endif + if (--SvREFCNT(sv) > 0) + return; sv_clear(sv); DEB(SvTYPE(sv) = 0xff;) del_SV(sv); @@ -1346,25 +1802,14 @@ STRLEN sv_len(sv) register SV *sv; { - I32 paren; - I32 i; char *s; + STRLEN len; if (!sv) return 0; - if (SvMAGICAL(sv)) - return mg_len(sv); - - if (!(SvPOK(sv))) { - (void)sv_2pv(sv); - if (!SvOK(sv)) - return 0; - } - if (SvPV(sv)) - return SvCUR(sv); - else - return 0; + s = SvPV(sv, len); + return len; } I32 @@ -1373,39 +1818,21 @@ register SV *str1; register SV *str2; { char *pv1; - U32 cur1; + STRLEN cur1; char *pv2; - U32 cur2; + STRLEN cur2; if (!str1) { pv1 = ""; cur1 = 0; } - else { - if (SvMAGICAL(str1)) - mg_get(str1); - if (!SvPOK(str1)) { - (void)sv_2pv(str1); - if (!SvPOK(str1)) - str1 = &sv_no; - } - pv1 = SvPV(str1); - cur1 = SvCUR(str1); - } + else + pv1 = SvPV(str1, cur1); if (!str2) return !cur1; - else { - if (SvMAGICAL(str2)) - mg_get(str2); - if (!SvPOK(str2)) { - (void)sv_2pv(str2); - if (!SvPOK(str2)) - return !cur1; - } - pv2 = SvPV(str2); - cur2 = SvCUR(str2); - } + else + pv2 = SvPV(str2, cur2); if (cur1 != cur2) return 0; @@ -1420,41 +1847,23 @@ register SV *str2; { I32 retval; char *pv1; - U32 cur1; + STRLEN cur1; char *pv2; - U32 cur2; + STRLEN cur2; if (!str1) { pv1 = ""; cur1 = 0; } - else { - if (SvMAGICAL(str1)) - mg_get(str1); - if (!SvPOK(str1)) { - (void)sv_2pv(str1); - if (!SvPOK(str1)) - str1 = &sv_no; - } - pv1 = SvPV(str1); - cur1 = SvCUR(str1); - } + else + pv1 = SvPV(str1, cur1); if (!str2) { pv2 = ""; cur2 = 0; } - else { - if (SvMAGICAL(str2)) - mg_get(str2); - if (!SvPOK(str2)) { - (void)sv_2pv(str2); - if (!SvPOK(str2)) - str2 = &sv_no; - } - pv2 = SvPV(str2); - cur2 = SvCUR(str2); - } + else + pv2 = SvPV(str2, cur2); if (!cur1) return cur2 ? -1 : 0; @@ -1492,7 +1901,7 @@ I32 append; I32 shortbuffered; if (SvREADONLY(sv)) - fatal(no_modify); + croak(no_modify); if (!SvUPGRADE(sv, SVt_PV)) return; if (rspara) { /* have to do this both before and after */ @@ -1519,7 +1928,7 @@ I32 append; } else shortbuffered = 0; - bp = SvPV(sv) + append; /* move these two too to registers */ + bp = SvPVX(sv) + append; /* move these two too to registers */ ptr = fp->_ptr; for (;;) { screamer: @@ -1533,10 +1942,10 @@ I32 append; if (shortbuffered) { /* oh well, must extend */ cnt = shortbuffered; shortbuffered = 0; - bpx = bp - SvPV(sv); /* prepare for possible relocation */ + bpx = bp - SvPVX(sv); /* prepare for possible relocation */ SvCUR_set(sv, bpx); SvGROW(sv, SvLEN(sv) + append + cnt + 2); - bp = SvPV(sv) + bpx; /* reconstitute our pointer */ + bp = SvPVX(sv) + bpx; /* reconstitute our pointer */ continue; } @@ -1546,10 +1955,10 @@ I32 append; cnt = fp->_cnt; ptr = fp->_ptr; /* reregisterize cnt and ptr */ - bpx = bp - SvPV(sv); /* prepare for possible relocation */ + bpx = bp - SvPVX(sv); /* prepare for possible relocation */ SvCUR_set(sv, bpx); SvGROW(sv, bpx + cnt + 2); - bp = SvPV(sv) + bpx; /* reconstitute our pointer */ + bp = SvPVX(sv) + bpx; /* reconstitute our pointer */ if (i == newline) { /* all done for now? */ *bp++ = i; @@ -1561,7 +1970,7 @@ I32 append; } thats_all_folks: - if (rslen > 1 && (bp - SvPV(sv) < rslen || bcmp(bp - rslen, rs, rslen))) + if (rslen > 1 && (bp - SvPVX(sv) < rslen || bcmp(bp - rslen, rs, rslen))) goto screamer; /* go back to the fray */ thats_really_all_folks: if (shortbuffered) @@ -1569,7 +1978,7 @@ thats_really_all_folks: fp->_cnt = cnt; /* put these back or we're in trouble */ fp->_ptr = ptr; *bp = '\0'; - SvCUR_set(sv, bp - SvPV(sv)); /* set length */ + SvCUR_set(sv, bp - SvPVX(sv)); /* set length */ #else /* !STDSTDIO */ /* The big, slow, and stupid way */ @@ -1593,7 +2002,7 @@ screamer: && (SvCUR(sv) < rslen || - bcmp(SvPV(sv) + SvCUR(sv) - rslen, rs, rslen) + bcmp(SvPVX(sv) + SvCUR(sv) - rslen, rs, rslen) ) ) ) @@ -1615,7 +2024,7 @@ screamer: } } } - return SvCUR(sv) - append ? SvPV(sv) : Nullch; + return SvCUR(sv) - append ? SvPVX(sv) : Nullch; } void @@ -1623,39 +2032,44 @@ sv_inc(sv) register SV *sv; { register char *d; + int flags; if (!sv) return; if (SvREADONLY(sv)) - fatal(no_modify); - if (SvMAGICAL(sv)) + croak(no_modify); + if (SvMAGICAL(sv)) { mg_get(sv); - if (SvIOK(sv)) { - ++SvIV(sv); + flags = SvPRIVATE(sv); + } + else + flags = SvFLAGS(sv); + if (flags & SVf_IOK) { + ++SvIVX(sv); SvIOK_only(sv); return; } - if (SvNOK(sv)) { - SvNV(sv) += 1.0; + if (flags & SVf_NOK) { + SvNVX(sv) += 1.0; SvNOK_only(sv); return; } - if (!SvPOK(sv) || !*SvPV(sv)) { + if (!(flags & SVf_POK) || !*SvPVX(sv)) { if (!SvUPGRADE(sv, SVt_NV)) return; - SvNV(sv) = 1.0; + SvNVX(sv) = 1.0; SvNOK_only(sv); return; } - d = SvPV(sv); + d = SvPVX(sv); while (isALPHA(*d)) d++; while (isDIGIT(*d)) d++; if (*d) { - sv_setnv(sv,atof(SvPV(sv)) + 1.0); /* punt */ + sv_setnv(sv,atof(SvPVX(sv)) + 1.0); /* punt */ return; } d--; - while (d >= SvPV(sv)) { + while (d >= SvPVX(sv)) { if (isDIGIT(*d)) { if (++*d <= '9') return; @@ -1671,7 +2085,7 @@ register SV *sv; /* oh,oh, the number grew */ SvGROW(sv, SvCUR(sv) + 2); SvCUR(sv)++; - for (d = SvPV(sv) + SvCUR(sv); d > SvPV(sv); d--) + for (d = SvPVX(sv) + SvCUR(sv); d > SvPVX(sv); d--) *d = d[-1]; if (isDIGIT(d[1])) *d = '1'; @@ -1683,30 +2097,36 @@ void sv_dec(sv) register SV *sv; { + int flags; + if (!sv) return; if (SvREADONLY(sv)) - fatal(no_modify); - if (SvMAGICAL(sv)) + croak(no_modify); + if (SvMAGICAL(sv)) { mg_get(sv); - if (SvIOK(sv)) { - --SvIV(sv); + flags = SvPRIVATE(sv); + } + else + flags = SvFLAGS(sv); + if (flags & SVf_IOK) { + --SvIVX(sv); SvIOK_only(sv); return; } - if (SvNOK(sv)) { - SvNV(sv) -= 1.0; + if (flags & SVf_NOK) { + SvNVX(sv) -= 1.0; SvNOK_only(sv); return; } - if (!SvPOK(sv)) { + if (!(flags & SVf_POK)) { if (!SvUPGRADE(sv, SVt_NV)) return; - SvNV(sv) = -1.0; + SvNVX(sv) = -1.0; SvNOK_only(sv); return; } - sv_setnv(sv,atof(SvPV(sv)) - 1.0); + sv_setnv(sv,atof(SvPVX(sv)) - 1.0); } /* Make a string that will exist for the duration of the expression @@ -1718,8 +2138,11 @@ SV * sv_mortalcopy(oldstr) SV *oldstr; { - register SV *sv = NEWSV(78,0); + register SV *sv; + new_SV(); + Zero(sv, 1, SV); + SvREFCNT(sv)++; sv_setsv(sv,oldstr); if (++tmps_ix > tmps_max) { tmps_max = tmps_ix; @@ -1745,7 +2168,7 @@ register SV *sv; if (!sv) return sv; if (SvREADONLY(sv)) - fatal(no_modify); + croak(no_modify); if (++tmps_ix > tmps_max) { tmps_max = tmps_ix; if (!(tmps_max & 127)) { @@ -1766,8 +2189,11 @@ newSVpv(s,len) char *s; STRLEN len; { - register SV *sv = NEWSV(79,0); + register SV *sv; + new_SV(); + Zero(sv, 1, SV); + SvREFCNT(sv)++; if (!len) len = strlen(s); sv_setpvn(sv,s,len); @@ -1778,8 +2204,11 @@ SV * newSVnv(n) double n; { - register SV *sv = NEWSV(80,0); + register SV *sv; + new_SV(); + Zero(sv, 1, SV); + SvREFCNT(sv)++; sv_setnv(sv,n); return sv; } @@ -1788,8 +2217,11 @@ SV * newSViv(i) I32 i; { - register SV *sv = NEWSV(80,0); + register SV *sv; + new_SV(); + Zero(sv, 1, SV); + SvREFCNT(sv)++; sv_setiv(sv,i); return sv; } @@ -1800,7 +2232,7 @@ SV * newSVsv(old) register SV *old; { - register SV *new; + register SV *sv; if (!old) return Nullsv; @@ -1808,15 +2240,17 @@ register SV *old; warn("semi-panic: attempt to dup freed string"); return Nullsv; } - new = NEWSV(80,0); + new_SV(); + Zero(sv, 1, SV); + SvREFCNT(sv)++; if (SvTEMP(old)) { SvTEMP_off(old); - sv_setsv(new,old); + sv_setsv(sv,old); SvTEMP_on(old); } else - sv_setsv(new,old); - return new; + sv_setsv(sv,old); + return sv; } void @@ -1830,6 +2264,7 @@ HV *stash; register I32 i; register PMOP *pm; register I32 max; + char todo[256]; if (!*s) { /* reset ?? searches */ for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) { @@ -1842,6 +2277,8 @@ HV *stash; if (!HvARRAY(stash)) return; + + Zero(todo, 256, char); while (*s) { i = *s; if (s[1] == '-') { @@ -1849,23 +2286,28 @@ HV *stash; } max = *s++; for ( ; i <= max; i++) { + todo[i] = 1; + } + for (i = 0; i <= HvMAX(stash); i++) { for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) { + if (!todo[(U8)*entry->hent_key]) + continue; gv = (GV*)entry->hent_val; sv = GvSV(gv); SvOK_off(sv); if (SvTYPE(sv) >= SVt_PV) { SvCUR_set(sv, 0); - SvTDOWN(sv); - if (SvPV(sv) != Nullch) - *SvPV(sv) = '\0'; + SvTAINT(sv); + if (SvPVX(sv) != Nullch) + *SvPVX(sv) = '\0'; } if (GvAV(gv)) { av_clear(GvAV(gv)); } if (GvHV(gv)) { - hv_clear(GvHV(gv), FALSE); + hv_clear(GvHV(gv)); if (gv == envgv) environ[0] = Nullch; } @@ -1874,76 +2316,6 @@ HV *stash; } } -#ifdef OLD -AV * -sv_2av(sv, st, gvp, lref) -SV *sv; -HV **st; -GV **gvp; -I32 lref; -{ - GV *gv; - - switch (SvTYPE(sv)) { - case SVt_PVAV: - *st = sv->sv_u.sv_stash; - *gvp = Nullgv; - return sv->sv_u.sv_av; - case SVt_PVHV: - case SVt_PVCV: - *gvp = Nullgv; - return Nullav; - default: - if (isGV(sv)) - gv = (GV*)sv; - else - gv = gv_fetchpv(SvPVn(sv), lref); - *gvp = gv; - if (!gv) - return Nullav; - *st = GvESTASH(gv); - if (lref) - return GvAVn(gv); - else - return GvAV(gv); - } -} - -HV * -sv_2hv(sv, st, gvp, lref) -SV *sv; -HV **st; -GV **gvp; -I32 lref; -{ - GV *gv; - - switch (SvTYPE(sv)) { - case SVt_PVHV: - *st = sv->sv_u.sv_stash; - *gvp = Nullgv; - return sv->sv_u.sv_hv; - case SVt_PVAV: - case SVt_PVCV: - *gvp = Nullgv; - return Nullhv; - default: - if (isGV(sv)) - gv = (GV*)sv; - else - gv = gv_fetchpv(SvPVn(sv), lref); - *gvp = gv; - if (!gv) - return Nullhv; - *st = GvESTASH(gv); - if (lref) - return GvHVn(gv); - else - return GvHV(gv); - } -} -#endif; - CV * sv_2cv(sv, st, gvp, lref) SV *sv; @@ -1960,7 +2332,7 @@ I32 lref; case SVt_REF: cv = (CV*)SvANY(sv); if (SvTYPE(cv) != SVt_PVCV) - fatal("Not a subroutine reference"); + croak("Not a subroutine reference"); *gvp = Nullgv; *st = CvSTASH(cv); return cv; @@ -1976,7 +2348,7 @@ I32 lref; if (isGV(sv)) gv = (GV*)sv; else - gv = gv_fetchpv(SvPVn(sv), lref); + gv = gv_fetchpv(SvPV(sv, na), lref); *gvp = gv; if (!gv) return Nullcv; @@ -2004,41 +2376,79 @@ register SV *sv; } else { if (SvIOK(sv)) - return SvIV(sv) != 0; + return SvIVX(sv) != 0; else { if (SvNOK(sv)) - return SvNV(sv) != 0.0; + return SvNVX(sv) != 0.0; else - return 0; + return sv_2bool(sv); } } } #endif /* SvTRUE */ -#ifndef SvNVn -double SvNVn(Sv) +#ifndef SvNV +double SvNV(Sv) register SV *Sv; { - SvTUP(Sv); - if (SvMAGICAL(sv)) - mg_get(sv); if (SvNOK(Sv)) - return SvNV(Sv); + return SvNVX(Sv); if (SvIOK(Sv)) - return (double)SvIV(Sv); + return (double)SvIVX(Sv); return sv_2nv(Sv); } -#endif /* SvNVn */ +#endif /* SvNV */ -#ifndef SvPVn +#ifdef CRIPPLED_CC char * -SvPVn(sv) +sv_pvn(sv, lp) SV *sv; +STRLEN *lp; { - SvTUP(sv); - if (SvMAGICAL(sv)) - mg_get(sv); - return SvPOK(sv) ? SvPV(sv) : sv_2pv(sv); + if (SvPOK(sv)) + return SvPVX(sv) + return sv_2pv(sv, lp); } #endif +int +sv_isa(sv, name) +SV *sv; +char *name; +{ + if (SvTYPE(sv) != SVt_REF) + return 0; + sv = (SV*)SvANY(sv); + if (SvSTORAGE(sv) != 'O') + return 0; + + return strEQ(HvNAME(SvSTASH(sv)), name); +} + +SV* +sv_setptrobj(rv, ptr, name) +SV *rv; +void *ptr; +char *name; +{ + HV *stash; + SV *sv; + + if (!ptr) + return rv; + + new_SV(); + Zero(sv, 1, SV); + SvREFCNT(sv)++; + sv_setnv(sv, (double)(unsigned long)ptr); + sv_upgrade(rv, SVt_REF); + SvANY(rv) = (void*)sv_ref(sv); + + stash = fetch_stash(newSVpv(name,0), TRUE); + SvSTORAGE(sv) = 'O'; + SvUPGRADE(sv, SVt_PVMG); + SvSTASH(sv) = stash; + + return rv; +} + @@ -55,7 +55,7 @@ typedef enum { /* Using C's structural equivalence to help emulate C++ inheritance here... */ struct sv { - ANY sv_any; /* pointer to something */ + 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 */ @@ -64,7 +64,7 @@ struct sv { }; struct gv { - ANY sv_any; /* pointer to something */ + 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 */ @@ -73,7 +73,7 @@ struct gv { }; struct cv { - ANY sv_any; /* pointer to something */ + 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 */ @@ -82,7 +82,7 @@ struct cv { }; struct av { - ANY sv_any; /* pointer to something */ + 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 */ @@ -91,7 +91,7 @@ struct av { }; struct hv { - ANY sv_any; /* pointer to something */ + 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 */ @@ -99,8 +99,7 @@ struct hv { U8 sv_private; /* extra value, depending on type */ }; -#define SvANY(sv) (sv)->sv_any.any_ptr -#define SvANYI32(sv) (sv)->sv_any.any_i32 +#define SvANY(sv) (sv)->sv_any #define SvTYPE(sv) (sv)->sv_type #define SvREFCNT(sv) (sv)->sv_refcnt #define SvFLAGS(sv) (sv)->sv_flags @@ -114,19 +113,23 @@ struct hv { #define SVf_POK 4 /* has valid pointer value */ #define SVf_OOK 8 /* has valid offset value */ #define SVf_MAGICAL 16 /* has special methods */ -#define SVf_SCREAM 32 /* eventually in sv_private? */ +#define SVf_OK 32 /* has defined value */ #define SVf_TEMP 64 /* eventually in sv_private? */ #define SVf_READONLY 128 /* may not be modified */ -#define SVp_TAINTED 128 /* is a security risk */ +#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 1 +#define SVpfm_COMPILED 128 -#define SVpbm_TAIL 1 -#define SVpbm_CASEFOLD 2 -#define SVpbm_VALID 4 +#define SVpbm_VALID 128 +#define SVpbm_CASEFOLD 64 +#define SVpbm_TAIL 32 -#define SVpgv_MULTI 1 +#define SVpgv_MULTI 128 struct xpv { char * xpv_pv; /* pointer to malloced string */ @@ -220,74 +223,40 @@ struct xpvfm { I32 xfm_lines; }; -/* XXX need to write custom routines for some of these */ -#define new_SV() (void*)malloc(sizeof(SV)) -#define del_SV(p) free((char*)p) - -#define new_XIV() (void*)malloc(sizeof(XPVIV)) -#define del_XIV(p) free((char*)p) - -#define new_XNV() (void*)malloc(sizeof(XPVNV)) -#define del_XNV(p) free((char*)p) - -#define new_XPV() (void*)malloc(sizeof(XPV)) -#define del_XPV(p) free((char*)p) - -#define new_XPVIV() (void*)malloc(sizeof(XPVIV)) -#define del_XPVIV(p) free((char*)p) - -#define new_XPVNV() (void*)malloc(sizeof(XPVNV)) -#define del_XPVNV(p) free((char*)p) - -#define new_XPVMG() (void*)malloc(sizeof(XPVMG)) -#define del_XPVMG(p) free((char*)p) - -#define new_XPVLV() (void*)malloc(sizeof(XPVLV)) -#define del_XPVLV(p) free((char*)p) - -#define new_XPVAV() (void*)malloc(sizeof(XPVAV)) -#define del_XPVAV(p) free((char*)p) - -#define new_XPVHV() (void*)malloc(sizeof(XPVHV)) -#define del_XPVHV(p) free((char*)p) - -#define new_XPVCV() (void*)malloc(sizeof(XPVCV)) -#define del_XPVCV(p) free((char*)p) - -#define new_XPVGV() (void*)malloc(sizeof(XPVGV)) -#define del_XPVGV(p) free((char*)p) - -#define new_XPVBM() (void*)malloc(sizeof(XPVBM)) -#define del_XPVBM(p) free((char*)p) - -#define new_XPVFM() (void*)malloc(sizeof(XPVFM)) -#define del_XPVFM(p) free((char*)p) - #define SvNIOK(sv) (SvFLAGS(sv) & (SVf_IOK|SVf_NOK)) -#define SvOK(sv) (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) -#define SvOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK), \ +#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), \ 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 SvIOK(sv) (SvFLAGS(sv) & SVf_IOK) -#define SvIOK_on(sv) (SvOOK_off(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) +#define SvIOK_only(sv) (SvOK_off(sv), SvFLAGS(sv) |= (SVf_IOK|SVf_OK)) #define SvNOK(sv) (SvFLAGS(sv) & SVf_NOK) -#define SvNOK_on(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) +#define SvNOK_only(sv) (SvOK_off(sv), SvFLAGS(sv) |= (SVf_NOK|SVf_OK)) #define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) -#define SvPOK_on(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) +#define SvPOK_only(sv) (SvOK_off(sv), SvFLAGS(sv) |= (SVf_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 SvOOK_only(sv) (SvOK_off(sv), SvFLAGS(sv) |= SVf_OOK) #define SvREADONLY(sv) (SvFLAGS(sv) & SVf_READONLY) #define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY) @@ -297,18 +266,14 @@ struct xpvfm { #define SvMAGICAL_on(sv) (SvFLAGS(sv) |= SVf_MAGICAL) #define SvMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVf_MAGICAL) -#define SvSCREAM(sv) (SvFLAGS(sv) & SVf_SCREAM) -#define SvSCREAM_on(sv) (SvFLAGS(sv) |= SVf_SCREAM) -#define SvSCREAM_off(sv) (SvFLAGS(sv) &= ~SVf_SCREAM) +#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) & SVf_TEMP) #define SvTEMP_on(sv) (SvFLAGS(sv) |= SVf_TEMP) #define SvTEMP_off(sv) (SvFLAGS(sv) &= ~SVf_TEMP) -#define SvTAINTED(sv) (SvPRIVATE(sv) & SVp_TAINTED) -#define SvTAINTED_on(sv) (SvPRIVATE(sv) |= SVp_TAINTED) -#define SvTAINTED_off(sv) (SvPRIVATE(sv) &= ~SVp_TAINTED) - #define SvCOMPILED(sv) (SvPRIVATE(sv) & SVpfm_COMPILED) #define SvCOMPILED_on(sv) (SvPRIVATE(sv) |= SVpfm_COMPILED) #define SvCOMPILED_off(sv) (SvPRIVATE(sv) &= ~SVpfm_COMPILED) @@ -329,14 +294,13 @@ struct xpvfm { #define SvMULTI_on(sv) (SvPRIVATE(sv) |= SVpgv_MULTI) #define SvMULTI_off(sv) (SvPRIVATE(sv) &= ~SVpgv_MULTI) -#define SvIV(sv) ((XPVIV*) SvANY(sv))->xiv_iv -#define SvIVx(sv) SvIV(sv) -#define SvNV(sv) ((XPVNV*)SvANY(sv))->xnv_nv -#define SvNVx(sv) SvNV(sv) -#define SvPV(sv) ((XPV*) SvANY(sv))->xpv_pv -#define SvPVx(sv) SvPV(sv) +#define SvIVX(sv) ((XPVIV*) SvANY(sv))->xiv_iv +#define SvIVXx(sv) SvIVX(sv) +#define SvNVX(sv) ((XPVNV*)SvANY(sv))->xnv_nv +#define SvNVXx(sv) SvNVX(sv) +#define SvPVX(sv) ((XPV*) SvANY(sv))->xpv_pv +#define SvPVXx(sv) SvPVX(sv) #define SvCUR(sv) ((XPV*) SvANY(sv))->xpv_cur -#define SvCURx(sv) SvCUR(sv) #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) @@ -361,7 +325,7 @@ struct xpvfm { (((XPV*) SvANY(sv))->xpv_len = val); } while (0) #define SvEND_set(sv, val) \ do { assert(SvTYPE(sv) >= SVt_PV); \ - (((XPV*) SvANY(sv))->xpv_cur = val - SvPV(sv)); } while (0) + (((XPV*) SvANY(sv))->xpv_cur = val - SvPVX(sv)); } while (0) #define SvCUROK(sv) (SvPOK(sv) ? SvCUR(sv) : 0) @@ -376,42 +340,30 @@ struct xpvfm { #define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff #define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen -#ifdef TAINT -#define SvTUP(sv) (tainted |= (SvPRIVATE(sv) & SVp_TAINTED)) -#define SvTUPc(sv) (tainted |= (SvPRIVATE(sv) & SVp_TAINTED)), -#define SvTDOWN(sv) (SvPRIVATE(sv) |= tainted ? SVp_TAINTED : 0) -#define SvTDOWNc(sv) (SvPRIVATE(sv) |= tainted ? SVp_TAINTED : 0), -#else -#define SvTUP(sv) -#define SvTUPc(sv) -#define SvTDOWN(sv) -#define SvTDOWNc(sv) -#endif +#define SvTAINT(sv) if (tainting && tainted) sv_magic(sv, 0, 't', 0, 0) #ifdef CRIPPLED_CC -double SvIVn(); -double SvNVn(); -char *SvPVn(); +double SvIV(); +double SvNV(); +#define SvPV(sv, lp) sv_pvn(sv, &lp) +char *sv_pvn(); I32 SvTRUE(); -#define SvIVnx(sv) SvIVn(sv) -#define SvNVnx(sv) SvNVn(sv) -#define SvPVnx(sv) SvPVn(sv) +#define SvIVx(sv) SvIV(sv) +#define SvNVx(sv) SvNV(sv) +#define SvPVx(sv, lp) sv_pvn(sv, &lp) #define SvTRUEx(sv) SvTRUE(sv) #else /* !CRIPPLED_CC */ -#define SvIVn(sv) (SvTUPc(sv) (SvMAGICAL(sv) && mg_get(sv)), \ - SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) +#define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) -#define SvNVn(sv) (SvTUPc(sv) (SvMAGICAL(sv) && mg_get(sv)), \ - SvNOK(sv) ? SvNV(sv) : sv_2nv(sv)) +#define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv)) -#define SvPVn(sv) (SvTUPc(sv) (SvMAGICAL(sv) && mg_get(sv)), \ - SvPOK(sv) ? SvPV(sv) : sv_2pv(sv)) +#define SvPV(sv, lp) (SvPOK(sv) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp)) -#define SvTRUE(sv) ((SvMAGICAL(sv) && mg_get(sv)), \ +#define SvTRUE(sv) ( \ SvPOK(sv) \ ? ((Xpv = (XPV*)SvANY(sv)) && \ (*Xpv->xpv_pv > '0' || \ @@ -421,28 +373,21 @@ I32 SvTRUE(); : 0) \ : \ SvIOK(sv) \ - ? SvIV(sv) != 0 \ + ? SvIVX(sv) != 0 \ : SvNOK(sv) \ - ? SvNV(sv) != 0.0 \ - : 0 ) + ? SvNVX(sv) != 0.0 \ + : sv_2bool(sv) ) -#define SvIVnx(sv) ((Sv = sv), SvIVn(Sv)) -#define SvNVnx(sv) ((Sv = sv), SvNVn(Sv)) -#define SvPVnx(sv) ((Sv = sv), SvPVn(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 SvGETMAGIC(x) \ - SvTUP(x); \ - if (SvMAGICAL(x)) mg_get(x) - -#define SvSETMAGIC(x) \ - SvTDOWN(x); \ - if (SvMAGICAL(x)) \ - mg_set(x) +#define SvSETMAGIC(x) if (SvMAGICAL(x)) mg_set(x) #define SvSetSV(dst,src) if (dst != src) sv_setsv(dst,src) @@ -461,4 +406,3 @@ I32 SvTRUE(); sv_grow(sv,(unsigned long)len) # define Sv_Grow(sv,len) sv_grow(sv,(unsigned long)(len)) #endif /* DOSISH */ - diff --git a/t/comp/cmdopt.t b/t/comp/cmdopt.t index 1ee3581464..4d5c78a4cb 100755 --- a/t/comp/cmdopt.t +++ b/t/comp/cmdopt.t @@ -33,7 +33,7 @@ if (1 || $x) { print "ok 15\n";} else { print "not ok 15\n";} if (0 || $x) { print "not ok 16\n";} else { print "ok 16\n";} -# test the optimization of registers +# test the optimization of variables $x = 1; if ($x) { print "ok 17\n";} else { print "not ok 17\n";} @@ -55,18 +55,18 @@ if ($a !~ /a/) { print "not ok 24\n";} else { print "ok 24\n";} $a = 'a'; $x = 1; -if ($a eq 'a' && $x) { print "ok 25\n";} else { print "not ok 25\n";} -if ($a ne 'a' && $x) { print "not ok 26\n";} else { print "ok 26\n";} +if ($a eq 'a' and $x) { print "ok 25\n";} else { print "not ok 25\n";} +if ($a ne 'a' and $x) { print "not ok 26\n";} else { print "ok 26\n";} $x = ''; -if ($a eq 'a' && $x) { print "not ok 27\n";} else { print "ok 27\n";} -if ($a ne 'a' && $x) { print "not ok 28\n";} else { print "ok 28\n";} +if ($a eq 'a' and $x) { print "not ok 27\n";} else { print "ok 27\n";} +if ($a ne 'a' and $x) { print "not ok 28\n";} else { print "ok 28\n";} $x = 1; -if ($a eq 'a' || $x) { print "ok 29\n";} else { print "not ok 29\n";} -if ($a ne 'a' || $x) { print "ok 30\n";} else { print "not ok 30\n";} +if ($a eq 'a' or $x) { print "ok 29\n";} else { print "not ok 29\n";} +if ($a ne 'a' or $x) { print "ok 30\n";} else { print "not ok 30\n";} $x = ''; -if ($a eq 'a' || $x) { print "ok 31\n";} else { print "not ok 31\n";} -if ($a ne 'a' || $x) { print "not ok 32\n";} else { print "ok 32\n";} +if ($a eq 'a' or $x) { print "ok 31\n";} else { print "not ok 31\n";} +if ($a ne 'a' or $x) { print "not ok 32\n";} else { print "ok 32\n";} $x = 1; if ($a =~ /a/ && $x) { print "ok 33\n";} else { print "not ok 33\n";} diff --git a/t/comp/package.t b/t/comp/package.t index 5237011a62..456c0ffa4d 100755 --- a/t/comp/package.t +++ b/t/comp/package.t @@ -19,14 +19,16 @@ $ABC'dyick = 6; $xyz = 2; -$main = join(':', sort(keys _main)); -$XYZ = join(':', sort(keys _XYZ)); -$ABC = join(':', sort(keys _ABC)); +$main = join(':', sort(keys %::_main)); +$XYZ = join(':', sort(keys %::_XYZ)); +$ABC = join(':', sort(keys %::_ABC)); print $XYZ eq 'ABC:XYZ:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$XYZ'\n"; -print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2\n"; +print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n"; print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n"; + package ABC; + print $blurfl == 5 ? "ok 4\n" : "not ok 4\n"; eval 'print $blurfl == 5 ? "ok 5\n" : "not ok 5\n";'; eval 'package main; print $blurfl == 123 ? "ok 6\n" : "not ok 6\n";'; diff --git a/t/op/dbm.t b/t/op/dbm.t index f09ca4febf..a011169865 100755 --- a/t/op/dbm.t +++ b/t/op/dbm.t @@ -10,11 +10,13 @@ if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h' print "1..12\n"; +init SDBM_File; + unlink <Op.dbmx.*>; unlink Op.dbmx; # in case we're running gdbm umask(0); -print (dbmopen(h,'Op.dbmx',0640) ? "ok 1\n" : "not ok 1\n"); +print (tie(%h,SDBM_File,'Op.dbmx', 0x202, 0640) ? "ok 1\n" : "not ok 1\n"); $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { @@ -24,7 +26,7 @@ if (! -e $Dfile) { ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat($Dfile); print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); -while (($key,$value) = each(h)) { +while (($key,$value) = each(%h)) { $i++; } print (!$i ? "ok 3\n" : "not ok 3\n"); @@ -48,8 +50,8 @@ $h{'i'} = 'I'; $h{'goner2'} = 'snork'; delete $h{'goner2'}; -dbmclose(h); -print (dbmopen(h,'Op.dbmx',0640) ? "ok 4\n" : "not ok 4\n"); +untie(%h); +print (tie(%h,SDBM_File,'Op.dbmx', 0x2, 0640) ? "ok 4\n" : "not ok 4\n"); $h{'j'} = 'J'; $h{'k'} = 'K'; diff --git a/t/op/ord.t b/t/op/ord.t index 67b8e24686..37128382d8 100755 --- a/t/op/ord.t +++ b/t/op/ord.t @@ -2,7 +2,7 @@ # $RCSfile: ord.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:09 $ -print "1..2\n"; +print "1..3\n"; # compile time evaluation @@ -12,3 +12,5 @@ if (ord('A') == 65) {print "ok 1\n";} else {print "not ok 1\n";} $x = 'ABC'; if (ord($x) == 65) {print "ok 2\n";} else {print "not ok 2\n";} + +if (chr 65 == A) {print "ok 3\n";} else {print "not ok 3\n";} diff --git a/t/op/sort.t b/t/op/sort.t index bf7a31759c..56a0fd3e92 100755 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -4,7 +4,7 @@ print "1..10\n"; -sub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; } +sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0; } @harry = ('dog','cat','x','Cain','Abel'); @george = ('gone','chased','yz','Punished','Axed'); @@ -12,7 +12,7 @@ sub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; } $x = join('', sort @harry); print ($x eq 'AbelCaincatdogx' ? "ok 1\n" : "not ok 1\n"); -$x = join('', sort reverse @harry); +$x = join('', sort backwards @harry); print ($x eq 'xdogcatCainAbel' ? "ok 2\n" : "not ok 2\n"); $x = join('', sort @george, 'to', @harry); @@ -42,7 +42,7 @@ print ("@b" eq "4 3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n"); @b = sort {$a <=> $b;} @a; print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n"); -$sub = 'reverse'; +$sub = 'backwards'; $x = join('', sort $sub @harry); print ($x eq 'xdogcatCainAbel' ? "ok 10\n" : "not ok 10\n"); diff --git a/t/op/time.t b/t/op/time.t index 347592dab4..6d23832dfa 100755 --- a/t/op/time.t +++ b/t/op/time.t @@ -8,7 +8,7 @@ print "1..5\n"; $beg = time; -while (($now = time) == $beg) {} +while (($now = time) == $beg) { sleep 1 } if ($now > $beg && $now - $beg < 10){print "ok 1\n";} else {print "not ok 1\n";} diff --git a/t/op/write.t b/t/op/write.t index 35aba42eaa..eb00d81b59 100755 --- a/t/op/write.t +++ b/t/op/write.t @@ -57,7 +57,7 @@ now @<<the@>>>> for all@|||||men to come @<<<< 'i' . 's', "time\n", $good, 'to' . -open(OUT2, '>Op.write.tmp') || die "Can't create Op.write.tmp"; +open OUT2, '>Op.write.tmp' or die "Can't create Op.write.tmp"; $fox = 'foxiness'; $good = 'good'; @@ -1,14 +1,38 @@ +#include "EXTERN.h" +#include "perl.h" + +void +taint_not(s) +char *s; +{ + if (euid != uid) + croak("No %s allowed while running setuid", s); + if (egid != gid) + croak("No %s allowed while running setgid", s); +} + void taint_proper(f, s) char *f; char *s; { - DEBUG_u(fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid)); - if (tainted && (!euid || euid != uid || egid != gid || taintanyway)) { - if (!unsafe) - fatal(f, s); - else if (dowarn) - warn(f, s); + if (tainting) { + DEBUG_u(fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid)); + if (tainted) { + char *ug = 0; + if (euid != uid) + ug = " while running setuid"; + else if (egid != gid) + ug = " while running setgid"; + else if (tainting) + ug = " while running with -T switch"; + if (ug) { + if (!unsafe) + croak(f, s, ug); + else if (dowarn) + warn(f, s, ug); + } + } } } @@ -17,18 +41,20 @@ taint_env() { SV** svp; - svp = hv_fetch(GvHVn(envgv),"PATH",4,FALSE); - if (!svp || *svp == &sv_undef || (*svp)->sv_tainted) { - tainted = 1; - if ((*svp)->sv_tainted == 2) - taint_proper("Insecure directory in %s", "PATH"); - else - taint_proper("Insecure %s", "PATH"); - } - svp = hv_fetch(GvHVn(envgv),"IFS",3,FALSE); - if (svp && *svp != &sv_undef && (*svp)->sv_tainted) { - tainted = 1; - taint_proper("Insecure %s", "IFS"); + if (tainting) { + svp = hv_fetch(GvHVn(envgv),"PATH",4,FALSE); + if (!svp || *svp == &sv_undef || mg_find(*svp, 't')) { + tainted = 1; + if (SvPRIVATE(*svp) & SVp_TAINTEDDIR) + taint_proper("Insecure directory in %s%s", "PATH"); + else + taint_proper("Insecure %s%s", "PATH"); + } + svp = hv_fetch(GvHVn(envgv),"IFS",3,FALSE); + if (svp && *svp != &sv_undef && mg_find(*svp, 't')) { + tainted = 1; + taint_proper("Insecure %s%s", "IFS"); + } } } diff --git a/tiearray b/tiearray new file mode 100755 index 0000000000..b765a853d5 --- /dev/null +++ b/tiearray @@ -0,0 +1,26 @@ +#!./perl + +# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ + +{ + package Any_DBM_File; + @ISA = (NDBM_File, ODBM_File, GDBM_File, SDBM_File, DB_File, DBZ_File); +} +{ + package FAKEARRAY; + sub new { print "new @_\n"; bless ['foo'] } + sub fetch { print "fetch @_\n"; $_[0]->[$_[1]] } + sub store { print "store @_\n"; $_[0]->[$_[1]] = $_[2] } + sub DESTROY { print "DESTROY @_\n"; undef @{$_[0]}; } +} + +tie @h, FAKEARRAY, ONE, TWO, THREE; + +$h[1] = 'bar'; +$h[2] = 'baz'; +print $h[0], "\n"; +print $h[1], "\n"; +print $h[2], "\n"; + +untie @h; + diff --git a/tiedbm b/tiedbm new file mode 100755 index 0000000000..8a675aa4be --- /dev/null +++ b/tiedbm @@ -0,0 +1,34 @@ +#!./perl + +# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ + +{ + package Any_DBM_File; + @ISA = (NDBM_File, ODBM_File, GDBM_File, SDBM_File, DB_File, DBZ_File); +} +{ + package XDBM_File; + sub new { print "new @_\n"; bless {FOO => 'foo'} } + sub fetch { print "fetch @_\n"; $_[0]->{$_[1]} } + sub store { print "store @_\n"; $_[0]->{$_[1]} = $_[2] } + sub delete { print "delete @_\n"; delete ${$_[0]}{$_[1]} } + sub DESTROY { print "DESTROY @_\n"; undef %{$_[0]}; } +} + +init SDBM_File; + +tie %h, SDBM_File, 'Op.sdbm', 0x202, 0640; + +$h{BAR} = 'bar'; +$h{FOO} = 'foo'; +#print $h{BAR}, "\n"; +#delete $h{BAR}; +#print $h{BAR}, "\n"; + +while (($key,$val) = each %h) { print "$key => $val\n"; } +@keys = sort keys %h; +@values = sort values %h; +print "@keys\n@values\n"; + +untie %h; + diff --git a/tiescalar b/tiescalar new file mode 100755 index 0000000000..ab92a2e333 --- /dev/null +++ b/tiescalar @@ -0,0 +1,20 @@ +#!./perl + +# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ +{ + package SOMEPACK; + sub new { local($x); bless \$x } + sub fetch { warn "fetch @_\n"; ${$_[0]} } + sub store { warn "store @_\n"; ${$_[0]} = $_[1] } + sub DESTROY { warn "DESTROY @_\n" } +} + +tie $h, SOMEPACK; + +$h = 'bar'; +print $h, "\n"; + +untie $h; +1; + + @@ -75,6 +75,7 @@ static void set_csh(); static U32 lex_state = LEX_NORMAL; /* next token is determined */ static U32 lex_defer; /* state after determined token */ +static expectation lex_expect; /* expect after determined token */ static I32 lex_brackets; /* bracket count */ static I32 lex_fakebrack; /* outer bracket is mere delimiter */ static I32 lex_casemods; /* casemod count */ @@ -85,6 +86,7 @@ static SV * lex_repl; /* runtime replacement from s/// */ static OP * lex_op; /* extra info to pass back on op */ static I32 lex_inpat; /* in pattern $) and $| are special */ static I32 lex_inwhat; /* what kind of quoting are we in */ +static char * lex_brackstack; /* what kind of brackets to pop */ /* What we know when we're in LEX_KNOWNEXT state. */ static YYSTYPE nextval[5]; /* value of next token, if any */ @@ -122,7 +124,7 @@ void checkcomma(); #define PREBLOCK(retval) return (expect = XBLOCK,bufptr = s,(int)retval) #define PREREF(retval) return (expect = XREF,bufptr = s,(int)retval) #define TERM(retval) return (CLINE, expect = XOPERATOR,bufptr = s,(int)retval) -#define LOOPX(f) return(yylval.ival=f,expect = XOPERATOR,bufptr = s,(int)LOOPEX) +#define LOOPX(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LOOPEX) #define FTST(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)UNIOP) #define FUN0(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC0) #define FUN1(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC1) @@ -161,19 +163,40 @@ void checkcomma(); /* grandfather return to old style */ #define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP) -#define SNARFWORD \ - *d++ = *s++; \ - while (s < bufend && isALNUM(*s)) \ - *d++ = *s++; \ - *d = '\0'; +void +no_op(what) +char *what; +{ + warn("%s found where operator expected", what); +} void -reinit_lexer() +lex_start() { + ENTER; + SAVEINT(lex_dojoin); + SAVEINT(lex_brackets); + SAVEINT(lex_fakebrack); + SAVEINT(lex_casemods); + SAVEINT(lex_starts); + SAVEINT(lex_state); + SAVEINT(lex_inpat); + SAVEINT(lex_inwhat); + SAVEINT(curcop->cop_line); + SAVESPTR(bufptr); + SAVESPTR(oldbufptr); + SAVESPTR(oldoldbufptr); + SAVESPTR(linestr); + SAVESPTR(lex_brackstack); + lex_state = LEX_NORMAL; lex_defer = 0; + lex_expect = XBLOCK; lex_brackets = 0; lex_fakebrack = 0; + if (lex_brackstack) + SAVESPTR(lex_brackstack); + lex_brackstack = malloc(120); lex_casemods = 0; lex_dojoin = 0; lex_starts = 0; @@ -185,7 +208,7 @@ reinit_lexer() lex_repl = Nullsv; lex_inpat = 0; lex_inwhat = 0; - oldoldbufptr = oldbufptr = bufptr = SvPVn(linestr); + oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr); bufend = bufptr + SvCUR(linestr); rs = "\n"; rslen = 1; @@ -193,13 +216,84 @@ reinit_lexer() rspara = 0; } +void +lex_end() +{ + free(lex_brackstack); + lex_brackstack = 0; + LEAVE; +} + +static void +incline(s) +char *s; +{ + char *t; + char *n; + char ch; + int sawline = 0; + + curcop->cop_line++; + if (*s++ != '#') + return; + while (*s == ' ' || *s == '\t') s++; + if (strnEQ(s, "line ", 5)) { + s += 5; + sawline = 1; + } + if (!isDIGIT(*s)) + return; + n = s; + while (isDIGIT(*s)) + s++; + while (*s == ' ' || *s == '\t') + s++; + if (*s == '"' && (t = strchr(s+1, '"'))) + s++; + else { + if (!sawline) + return; /* false alarm */ + for (t = s; !isSPACE(*t); t++) ; + } + ch = *t; + *t = '\0'; + if (t - s > 0) + curcop->cop_filegv = gv_fetchfile(s); + else + curcop->cop_filegv = gv_fetchfile(origfilename); + *t = ch; + curcop->cop_line = atoi(n)-1; +} + char * skipspace(s) register char *s; { - while (s < bufend && isSPACE(*s)) - s++; - return s; + if (in_format && lex_brackets <= 1) { + while (s < bufend && (*s == ' ' || *s == '\t')) + s++; + return s; + } + for (;;) { + while (s < bufend && isSPACE(*s)) + s++; + if (s < bufend && *s == '#') { + while (s < bufend && *s != '\n') + s++; + if (s < bufend) + 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); + return s; + } + oldoldbufptr = oldbufptr = bufptr = s; + bufend = bufptr + SvCUR(linestr); + incline(s); + } } void @@ -272,26 +366,38 @@ I32 type; nexttoke++; if (lex_state != LEX_KNOWNEXT) { lex_defer = lex_state; + lex_expect = expect; lex_state = LEX_KNOWNEXT; } } char * -force_word(s,token) -register char *s; +force_word(start,token,check_keyword,allow_tick) +register char *start; int token; +int check_keyword; +int allow_tick; { - register char *d; - - s = skipspace(s); - if (isIDFIRST(*s) || *s == '\'') { - d = tokenbuf; - SNARFWORD; - while (s < bufend && *s == '\'' && isIDFIRST(s[1])) { - *d++ = *s++; - SNARFWORD; + register char *s; + STRLEN len; + + start = skipspace(start); + s = start; + if (isIDFIRST(*s) || (allow_tick && (*s == '\'' || *s == ':'))) { + s = scan_word(s, tokenbuf, allow_tick, &len); + if (check_keyword && keyword(tokenbuf, len)) + return start; + if (token == METHOD) { + s = skipspace(s); + if (*s == '(') + expect = XTERM; + else { + expect = XOPERATOR; + force_next(')'); + force_next('('); + } } - nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); + nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(tokenbuf,0)); force_next(token); } return s; @@ -315,12 +421,13 @@ SV *sv; register char *send; register char *d; register char delim; + STRLEN len; if (!SvLEN(sv)) return sv; - s = SvPVn(sv); - send = s + SvCUR(sv); + s = SvPV(sv, len); + send = s + len; while (s < send && *s != '\\') s++; if (s == send) @@ -335,7 +442,7 @@ SV *sv; *d++ = *s++; } *d = '\0'; - SvCUR_set(sv, d - SvPV(sv)); + SvCUR_set(sv, d - SvPVX(sv)); return sv; } @@ -345,6 +452,7 @@ sublex_start() { register I32 op_type = yylval.ival; SV *sv; + STRLEN len; if (op_type == OP_NULL) { yylval.opval = lex_op; @@ -371,16 +479,18 @@ sublex_start() SAVESPTR(oldbufptr); SAVESPTR(oldoldbufptr); SAVESPTR(linestr); + SAVESPTR(lex_brackstack); linestr = lex_stuff; lex_stuff = Nullsv; - bufend = bufptr = oldbufptr = oldoldbufptr = SvPVn(linestr); + bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr); bufend += SvCUR(linestr); lex_dojoin = FALSE; lex_brackets = 0; lex_fakebrack = 0; + lex_brackstack = malloc(120); lex_casemods = 0; lex_starts = 0; lex_state = LEX_INTERPCONCAT; @@ -392,6 +502,7 @@ sublex_start() else lex_inpat = 0; + expect = XTERM; force_next('('); if (lex_op) { yylval.opval = lex_op; @@ -421,7 +532,7 @@ sublex_done() if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) { linestr = lex_repl; lex_inpat = 0; - bufend = bufptr = oldbufptr = oldoldbufptr = SvPVn(linestr); + bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr); bufend += SvCUR(linestr); lex_dojoin = FALSE; lex_brackets = 0; @@ -438,8 +549,12 @@ sublex_done() return ','; } else { + if (lex_brackstack) + free(lex_brackstack); + lex_brackstack = 0; + pop_scope(); - bufend = SvPVn(linestr); + bufend = SvPVX(linestr); bufend += SvCUR(linestr); expect = XOPERATOR; return ')'; @@ -453,7 +568,7 @@ char *start; register char *send = bufend; SV *sv = NEWSV(93, send - start); register char *s = start; - register char *d = SvPV(sv); + register char *d = SvPVX(sv); char delim = SvSTORAGE(linestr); bool dorange = FALSE; I32 len; @@ -469,9 +584,9 @@ char *start; if (dorange) { I32 i; I32 max; - i = d - SvPV(sv); + i = d - SvPVX(sv); SvGROW(sv, SvLEN(sv) + 256); - d = SvPV(sv) + i; + d = SvPVX(sv) + i; d -= 2; max = d[1] & 0377; for (i = (*d & 0377); i <= max; i++) @@ -567,12 +682,12 @@ char *start; *d++ = *s++; } *d = '\0'; - SvCUR_set(sv, d - SvPV(sv)); + SvCUR_set(sv, d - SvPVX(sv)); SvPOK_on(sv); if (SvCUR(sv) + 5 < SvLEN(sv)) { SvLEN_set(sv, SvCUR(sv) + 1); - Renew(SvPV(sv), SvLEN(sv), char); + Renew(SvPVX(sv), SvLEN(sv), char); } if (s > bufptr) yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv); @@ -711,13 +826,17 @@ register char *s; return TRUE; } +static char* exp_name[] = { "OPERATOR", "TERM", "BLOCK", "REF" }; + +extern int yychar; /* last token */ + int yylex() { register char *s; register char *d; register I32 tmp; - extern int yychar; /* last token */ + STRLEN len; switch (lex_state) { #ifdef COMMENTARY @@ -729,14 +848,16 @@ yylex() case LEX_KNOWNEXT: nexttoke--; yylval = nextval[nexttoke]; - if (!nexttoke) + if (!nexttoke) { lex_state = lex_defer; + expect = lex_expect; + } return(nexttype[nexttoke]); case LEX_INTERPCASEMOD: #ifdef DEBUGGING if (bufptr != bufend && *bufptr != '\\') - fatal("panic: INTERPCASEMOD"); + croak("panic: INTERPCASEMOD"); #endif if (bufptr == bufend || bufptr[1] == 'E') { if (lex_casemods <= 1) { @@ -750,6 +871,10 @@ yylex() } return yylex(); } + else if (lex_casemods) { + --lex_casemods; + return ')'; + } else { s = bufptr + 1; if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3)) @@ -767,11 +892,12 @@ yylex() else if (*s == 'U') nextval[nexttoke].ival = OP_UC; else - fatal("panic: yylex"); + croak("panic: yylex"); bufptr = s + 1; force_next(FUNC); if (lex_starts) { s = bufptr; + lex_starts = 0; Aop(OP_CONCAT); } else @@ -820,7 +946,7 @@ yylex() case LEX_INTERPCONCAT: #ifdef DEBUGGING if (lex_brackets) - fatal("panic: INTERPCONCAT"); + croak("panic: INTERPCONCAT"); #endif if (bufptr == bufend) return sublex_done(); @@ -842,6 +968,7 @@ yylex() if (s != bufptr) { nextval[nexttoke] = yylval; + expect = XTERM; force_next(THING); if (lex_starts++) Aop(OP_CONCAT); @@ -857,14 +984,11 @@ yylex() s = bufptr; oldoldbufptr = oldbufptr; oldbufptr = s; - - retry: DEBUG_p( { - if (strchr(s,'\n')) - fprintf(stderr,"Tokener at %s",s); - else - fprintf(stderr,"Tokener at %s\n",s); + fprintf(stderr,"### Tokener expecting %s at %s\n", exp_name[expect], s); } ) + + retry: #ifdef BADSWITCH if (*s & 128) { if ((*s & 127) == '}') { @@ -889,8 +1013,11 @@ yylex() case 26: goto fake_eof; /* emulate EOF on ^D or ^Z */ case 0: - if (!rsfp) + if (!rsfp) { + if (lex_brackets) + yyerror("Missing right bracket"); TOKEN(0); + } if (s++ < bufend) goto retry; /* ignore stray nulls */ last_uni = 0; @@ -901,7 +1028,7 @@ yylex() if (perldb) { char *pdb = getenv("PERLDB"); - sv_catpv(linestr,"BEGIN{"); + sv_catpv(linestr,"{"); sv_catpv(linestr, pdb ? pdb : "require 'perldb.pl'"); sv_catpv(linestr, "}"); } @@ -912,8 +1039,8 @@ yylex() if (minus_a) sv_catpv(linestr,"@F=split(' ');"); } - oldoldbufptr = oldbufptr = s = SvPVn(linestr); - bufend = SvPV(linestr) + SvCUR(linestr); + oldoldbufptr = oldbufptr = s = SvPVX(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); goto retry; } #ifdef CRYPTSCRIPT @@ -934,18 +1061,18 @@ yylex() if (minus_n || minus_p) { sv_setpv(linestr,minus_p ? ";}continue{print" : ""); sv_catpv(linestr,";}"); - oldoldbufptr = oldbufptr = s = SvPVn(linestr); - bufend = SvPV(linestr) + SvCUR(linestr); + oldoldbufptr = oldbufptr = s = SvPVX(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); minus_n = minus_p = 0; goto retry; } - oldoldbufptr = oldbufptr = s = SvPVn(linestr); + oldoldbufptr = oldbufptr = s = SvPVX(linestr); sv_setpv(linestr,""); TOKEN(';'); /* not infinite loop because rsfp is NULL now */ } - if (doextract && *SvPV(linestr) == '#') + if (doextract && *s == '#') doextract = FALSE; - curcop->cop_line++; + incline(s); } while (doextract); oldoldbufptr = oldbufptr = bufptr = s; if (perldb) { @@ -955,7 +1082,7 @@ yylex() sv_setsv(sv,linestr); av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv); } - bufend = SvPV(linestr) + SvCUR(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); if (curcop->cop_line == 1) { while (s < bufend && isSPACE(*s)) s++; @@ -987,7 +1114,7 @@ yylex() newargv = origargv; newargv[0] = cmd; execv(cmd,newargv); - fatal("Can't exec %s", cmd); + croak("Can't exec %s", cmd); } if (d = instr(s, "perl -")) { d += 6; @@ -1007,26 +1134,6 @@ yylex() s++; goto retry; case '#': - if (preprocess && s == SvPVn(linestr) && - s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) { - while (*s && !isDIGIT(*s)) - s++; - curcop->cop_line = atoi(s)-1; - while (isDIGIT(*s)) - s++; - s = skipspace(s); - s[strlen(s)-1] = '\0'; /* wipe out newline */ - if (*s == '"') { - s++; - s[strlen(s)-1] = '\0'; /* wipe out trailing quote */ - } - if (*s) - curcop->cop_filegv = gv_fetchfile(s); - else - curcop->cop_filegv = gv_fetchfile(origfilename); - oldoldbufptr = oldbufptr = s = SvPVn(linestr); - } - /* FALL THROUGH */ case '\n': if (lex_state != LEX_NORMAL || (in_eval && !rsfp)) { d = bufend; @@ -1034,7 +1141,7 @@ yylex() s++; if (s < d) s++; - curcop->cop_line++; + incline(s); if (in_format && lex_brackets <= 1) { s = scan_formline(s); if (!in_format) @@ -1096,14 +1203,11 @@ yylex() s++; s = skipspace(s); if (isIDFIRST(*s)) { - /*SUPPRESS 530*/ - for (d = s; isALNUM(*d); d++) ; - strncpy(tokenbuf,s,d-s); - tokenbuf[d-s] = '\0'; - if (!keyword(tokenbuf, d - s)) - s = force_word(s,METHOD); + s = force_word(s,METHOD,TRUE,FALSE); + TOKEN(ARROW); } - PREBLOCK(ARROW); + else + PREBLOCK(ARROW); } if (expect == XOPERATOR) Aop(OP_SUBTRACT); @@ -1133,6 +1237,7 @@ yylex() case '*': if (expect != XOPERATOR) { s = scan_ident(s, bufend, tokenbuf, TRUE); + expect = XOPERATOR; force_ident(tokenbuf); TERM('*'); } @@ -1147,16 +1252,17 @@ yylex() if (expect != XOPERATOR) { s = scan_ident(s, bufend, tokenbuf + 1, TRUE); if (tokenbuf[1]) { + expect = XOPERATOR; tokenbuf[0] = '%'; if (in_my) { - if (strchr(tokenbuf,'\'')) - fatal("\"my\" variable %s can't be in a package",tokenbuf); + if (strchr(tokenbuf,':')) + croak("\"my\" variable %s can't be in a package",tokenbuf); nextval[nexttoke].opval = newOP(OP_PADHV, 0); nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf); force_next(PRIVATEREF); TERM('%'); } - if (!strchr(tokenbuf,'\'')) { + if (!strchr(tokenbuf,':')) { if (tmp = pad_findmy(tokenbuf)) { nextval[nexttoke].opval = newOP(OP_PADHV, 0); nextval[nexttoke].opval->op_targ = tmp; @@ -1180,8 +1286,8 @@ yylex() lex_brackets++; /* FALL THROUGH */ case '~': - case '(': case ',': + case '(': case ':': tmp = *s++; OPERATOR(tmp); @@ -1195,8 +1301,12 @@ yylex() TERM(tmp); case ']': s++; + if (lex_brackets <= 0) + yyerror("Unmatched right bracket"); + else + --lex_brackets; if (lex_state == LEX_INTERPNORMAL) { - if (--lex_brackets == 0) { + if (lex_brackets == 0) { if (*s != '-' || s[1] != '>') lex_state = LEX_INTERPEND; } @@ -1207,13 +1317,31 @@ yylex() if (in_format == 2) in_format = 0; s++; - lex_brackets++; + if (lex_brackets > 100) + realloc(lex_brackstack, lex_brackets + 1); + 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 == XREF) { + char *t; + s = skipspace(s); + if (*s == '}') + OPERATOR(HASHBRACK); + for (t = s; + t < bufend && + (isSPACE(*t) || isALPHA(*t) || *t == '"' || *t == '\''); + t++) ; + if (*t == ',' || (*t == '=' && t[1] == '>')) + OPERATOR(HASHBRACK); expect = XTERM; - else + } + else { + lex_brackstack[lex_brackets-1] = XBLOCK; expect = XBLOCK; + } yylval.ival = curcop->cop_line; if (isSPACE(*s) || *s == '#') copline = NOLINE; /* invalidate current command line number */ @@ -1221,8 +1349,12 @@ yylex() case '}': rightbracket: s++; + if (lex_brackets <= 0) + yyerror("Unmatched right bracket"); + else + expect = (expectation)lex_brackstack[--lex_brackets]; if (lex_state == LEX_INTERPNORMAL) { - if (--lex_brackets == 0) { + if (lex_brackets == 0) { if (lex_fakebrack) { lex_state = LEX_INTERPEND; bufptr = s; @@ -1240,12 +1372,20 @@ yylex() if (tmp == '&') OPERATOR(ANDAND); s--; - if (expect == XOPERATOR) + if (expect == XOPERATOR) { + if (dowarn && isALPHA(*s) && bufptr == SvPVX(linestr)) { + curcop->cop_line--; + warn(warn_nosemi); + curcop->cop_line++; + } BAop(OP_BIT_AND); + } s = scan_ident(s-1, bufend, tokenbuf, TRUE); - if (*tokenbuf) + if (*tokenbuf) { + expect = XOPERATOR; force_ident(tokenbuf); + } else PREREF('&'); TERM('&'); @@ -1266,6 +1406,8 @@ yylex() OPERATOR(','); if (tmp == '~') PMop(OP_MATCH); + if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp)) + warn("Reversed %c= operator",tmp); s--; if (in_format == 2 && (tmp == '\n' || s[1] == '\n')) { in_format = 1; @@ -1317,12 +1459,17 @@ yylex() Rop(OP_GT); case '$': - if (in_format && expect == XOPERATOR) - OPERATOR(','); /* grandfather non-comma-format format */ - if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) { + 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); + expect = XOPERATOR; force_ident(tokenbuf); - TERM(DOLSHARP); + TOKEN(DOLSHARP); } s = scan_ident(s, bufend, tokenbuf+1, FALSE); if (tokenbuf[1]) { @@ -1337,14 +1484,33 @@ yylex() t-bufptr+1, bufptr); } } + expect = XOPERATOR; + 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) + expect = XOPERATOR; + else if (strchr("&*<%", *s) && isIDFIRST(s[1])) + expect = XTERM; /* e.g. print $fh &sub */ + else if (isDIGIT(*s)) + expect = XTERM; /* e.g. print $fh 3 */ + else if (*s == '.' && isDIGIT(s[1])) + expect = XTERM; /* e.g. print $fh .3 */ + else if (strchr("/?-+", *s) && !isSPACE(s[1])) + expect = XTERM; /* e.g. print $fh -1 */ + else if (*s == '<' && s[1] == '<' && !isSPACE(s[2])) + expect = XTERM; /* print $fh <<"EOF" */ + } if (in_my) { - if (strchr(tokenbuf,'\'')) - fatal("\"my\" variable %s can't be in a package",tokenbuf); + if (strchr(tokenbuf,':')) + croak("\"my\" variable %s can't be in a package",tokenbuf); nextval[nexttoke].opval = newOP(OP_PADSV, 0); nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf); force_next(PRIVATEREF); } - else if (!strchr(tokenbuf,'\'')) { + else if (!strchr(tokenbuf,':')) { I32 optype = OP_PADSV; if (*s == '[') { tokenbuf[0] = '@'; @@ -1365,42 +1531,29 @@ yylex() else force_ident(tokenbuf+1); } - else + else { + if (s == bufend) + yyerror("Final $ should be \\$ or $name"); PREREF('$'); - expect = XOPERATOR; - if (lex_state == LEX_NORMAL && - *tokenbuf && - isSPACE(*s) && - oldoldbufptr && - oldoldbufptr < bufptr) - { - s++; - while (isSPACE(*oldoldbufptr)) - oldoldbufptr++; - if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) { - if (strchr("&*<%", *s) && isIDFIRST(s[1])) - expect = XTERM; /* e.g. print $fh &sub */ - else if (*s == '.' && isDIGIT(s[1])) - expect = XTERM; /* e.g. print $fh .3 */ - else if (strchr("/?-+", *s) && !isSPACE(s[1])) - expect = XTERM; /* e.g. print $fh -1 */ - } } TOKEN('$'); case '@': + if (expect == XOPERATOR) + no_op("Array"); s = scan_ident(s, bufend, tokenbuf+1, FALSE); if (tokenbuf[1]) { tokenbuf[0] = '@'; + expect = XOPERATOR; if (in_my) { - if (strchr(tokenbuf,'\'')) - fatal("\"my\" variable %s can't be in a package",tokenbuf); + if (strchr(tokenbuf,':')) + croak("\"my\" variable %s can't be in a package",tokenbuf); nextval[nexttoke].opval = newOP(OP_PADAV, 0); nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf); force_next(PRIVATEREF); TERM('@'); } - else if (!strchr(tokenbuf,'\'')) { + else if (!strchr(tokenbuf,':')) { I32 optype = OP_PADAV; if (*s == '{') { tokenbuf[0] = '%'; @@ -1424,8 +1577,11 @@ yylex() } force_ident(tokenbuf+1); } - else + else { + if (s == bufend) + yyerror("Final @ should be \\@ or @name"); PREREF('@'); + } TERM('@'); case '/': /* may either be division or pattern */ @@ -1443,6 +1599,7 @@ yylex() case '.': if (in_format == 2) { in_format = 0; + expect = XBLOCK; goto rightbracket; } if (expect == XOPERATOR || !isDIGIT(s[1])) { @@ -1464,36 +1621,50 @@ 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); TERM(THING); case '\'': - if (in_format && expect == XOPERATOR) - OPERATOR(','); /* grandfather non-comma-format format */ + if (expect == XOPERATOR) { + if (in_format) + OPERATOR(','); /* grandfather non-comma-format format */ + else + no_op("String"); + } s = scan_str(s); if (!s) - fatal("EOF in string"); + croak("EOF in string"); yylval.ival = OP_CONST; TERM(sublex_start()); case '"': - if (in_format && expect == XOPERATOR) - OPERATOR(','); /* grandfather non-comma-format format */ + if (expect == XOPERATOR) { + if (in_format) + OPERATOR(','); /* grandfather non-comma-format format */ + else + no_op("String"); + } s = scan_str(s); if (!s) - fatal("EOF in string"); + croak("EOF in string"); yylval.ival = OP_SCALAR; TERM(sublex_start()); case '`': + if (expect == XOPERATOR) + no_op("Backticks"); s = scan_str(s); if (!s) - fatal("EOF in backticks"); + croak("EOF in backticks"); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); case '\\': + if (expect == XOPERATOR) + no_op("Backslash"); s++; OPERATOR(REFGEN); @@ -1533,18 +1704,16 @@ yylex() case 'z': case 'Z': keylookup: - d = tokenbuf; - SNARFWORD; - - switch (tmp = keyword(tokenbuf, d - tokenbuf)) { + d = s; + s = scan_word(s, tokenbuf, FALSE, &len); + + switch (tmp = keyword(tokenbuf, len)) { default: /* not a keyword */ just_a_word: { GV *gv; - while (*s == '\'' && isIDFIRST(s[1])) { - *d++ = *s++; - SNARFWORD; - } + if (*s == '\'' || *s == ':') + s = scan_word(s, tokenbuf + len, TRUE, &len); if (expect == XBLOCK) { /* special case: start of statement */ while (isSPACE(*s)) s++; if (*s == ':') { @@ -1554,13 +1723,32 @@ yylex() TOKEN(LABEL); } } + else if (dowarn && expect == XOPERATOR) { + if (bufptr == SvPVX(linestr)) { + curcop->cop_line--; + warn(warn_nosemi); + curcop->cop_line++; + } + else + no_op("Bare word"); + } 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; - force_next(WORD); - TERM(NOAMP); + s = skipspace(s); + if (*s == '(') { + expect = XTERM; + force_next(WORD); + TOKEN('&'); + } + else { + last_lop = oldbufptr; + expect = XBLOCK; + force_next(WORD); + TOKEN(NOAMP); + } } expect = XOPERATOR; if (oldoldbufptr && oldoldbufptr < bufptr) { @@ -1572,9 +1760,7 @@ yylex() yylval.opval->op_private = OPpCONST_BARE; for (d = tokenbuf; *d && isLOWER(*d); d++) ; if (dowarn && !*d) - warn( - "\"%s\" may clash with future reserved word", - tokenbuf ); + warn(warn_reserved, tokenbuf); TOKEN(WORD); } } @@ -1585,21 +1771,40 @@ yylex() nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); nextval[nexttoke].opval->op_private = OPpCONST_BARE; + expect = XOPERATOR; force_next(WORD); - TERM('&'); + TOKEN('&'); } CLINE; yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); yylval.opval->op_private = OPpCONST_BARE; - if (*s == '$' || *s == '{') + if (*s == '$' || *s == '{') { + last_lop = oldbufptr; PREBLOCK(METHOD); + } + + if (isALPHA(*s)) { + char *olds = s; + char tmpbuf[1024]; + 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); + } + } + s = olds; + } for (d = tokenbuf; *d && isLOWER(*d); d++) ; if (dowarn && !*d) - warn( - "\"%s\" may clash with future reserved word", - tokenbuf ); + warn(warn_reserved, tokenbuf); TOKEN(WORD); } @@ -1608,7 +1813,7 @@ yylex() if (tokenbuf[2] == 'L') (void)sprintf(tokenbuf,"%ld",(long)curcop->cop_line); else - strcpy(tokenbuf, SvPV(GvSV(curcop->cop_filegv))); + strcpy(tokenbuf, SvPVX(GvSV(curcop->cop_filegv))); yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); TERM(THING); } @@ -1647,12 +1852,18 @@ yylex() } goto just_a_word; + case KEY_abs: + UNI(OP_ABS); + case KEY_alarm: UNI(OP_ALARM); case KEY_accept: LOP(OP_ACCEPT); + case KEY_and: + OPERATOR(ANDOP); + case KEY_atan2: LOP(OP_ATAN2); @@ -1663,7 +1874,7 @@ yylex() UNI(OP_BINMODE); case KEY_bless: - UNI(OP_BLESS); + LOP(OP_BLESS); case KEY_chop: UNI(OP_CHOP); @@ -1706,6 +1917,9 @@ yylex() case KEY_connect: LOP(OP_CONNECT); + case KEY_chr: + UNI(OP_CHR); + case KEY_cos: UNI(OP_COS); @@ -1717,7 +1931,7 @@ yylex() if (*s == '{') PREBLOCK(DO); if (*s != '\'') - s = force_word(s,WORD); + s = force_word(s,WORD,FALSE,TRUE); OPERATOR(DO); case KEY_die: @@ -1752,10 +1966,9 @@ yylex() UNI(OP_EXIT); case KEY_eval: - allgvs = TRUE; /* must initialize everything since */ s = skipspace(s); expect = (*s == '{') ? XBLOCK : XTERM; - UNIBRACK(OP_ENTEREVAL); /* we don't know what will be used */ + UNIBRACK(OP_ENTEREVAL); case KEY_eof: UNI(OP_EOF); @@ -1794,7 +2007,7 @@ yylex() while (s < bufend && isSPACE(*s)) s++; if (isIDFIRST(*s)) - fatal("Missing $ on loop variable"); + croak("Missing $ on loop variable"); OPERATOR(FOR); case KEY_formline: @@ -1934,6 +2147,7 @@ yylex() LOP(OP_KILL); case KEY_last: + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_LAST); case KEY_lc: @@ -1995,6 +2209,7 @@ yylex() OPERATOR(LOCAL); case KEY_next: + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_NEXT); case KEY_ne: @@ -2012,6 +2227,9 @@ yylex() } LOP(OP_OPEN); + case KEY_or: + OPERATOR(OROP); + case KEY_ord: UNI(OP_ORD); @@ -2039,7 +2257,7 @@ yylex() LOP(OP_PACK); case KEY_package: - s = force_word(s,WORD); + s = force_word(s,WORD,FALSE,TRUE); OPERATOR(PACKAGE); case KEY_pipe: @@ -2048,14 +2266,14 @@ yylex() case KEY_q: s = scan_str(s); if (!s) - fatal("EOF in string"); + croak("EOF in string"); yylval.ival = OP_CONST; TERM(sublex_start()); case KEY_qq: s = scan_str(s); if (!s) - fatal("EOF in string"); + croak("EOF in string"); yylval.ival = OP_SCALAR; if (SvSTORAGE(lex_stuff) == '\'') SvSTORAGE(lex_stuff) = 0; /* qq'$foo' should intepolate */ @@ -2064,7 +2282,7 @@ yylex() case KEY_qx: s = scan_str(s); if (!s) - fatal("EOF in string"); + croak("EOF in string"); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); @@ -2073,13 +2291,13 @@ yylex() OLDLOP(OP_RETURN); case KEY_require: - allgvs = TRUE; /* must initialize everything since */ - UNI(OP_REQUIRE); /* we don't know what will be used */ + UNI(OP_REQUIRE); case KEY_reset: UNI(OP_RESET); case KEY_redo: + s = force_word(s,WORD,TRUE,FALSE); LOOPX(OP_REDO); case KEY_rename: @@ -2215,15 +2433,9 @@ yylex() checkcomma(s,tokenbuf,"subroutine name"); s = skipspace(s); if (*s == ';' || *s == ')') /* probably a close */ - fatal("sort is now a reserved word"); - if (isIDFIRST(*s)) { - /*SUPPRESS 530*/ - for (d = s; isALNUM(*d); d++) ; - strncpy(tokenbuf,s,d-s); - tokenbuf[d-s] = '\0'; - if (!keyword(tokenbuf, d - s) || strEQ(tokenbuf,"reverse")) - s = force_word(s,WORD); - } + croak("sort is now a reserved word"); + expect = XTERM; + s = force_word(s,WORD,TRUE,TRUE); LOP(OP_SORT); case KEY_split: @@ -2271,16 +2483,21 @@ yylex() subline = curcop->cop_line; s = skipspace(s); - if (isIDFIRST(*s) || *s == '\'') { - sv_setsv(subname,curstname); - sv_catpvn(subname,"'",1); - for (d = s+1; isALNUM(*d) || *d == '\''; d++) - /*SUPPRESS 530*/ - ; - if (d[-1] == '\'') - d--; - sv_catpvn(subname,s,d-s); - s = force_word(s,WORD); + if (tmp == KEY_format) + expect = XTERM; + else + expect = XBLOCK; + if (isIDFIRST(*s) || *s == '\'' || *s == ':') { + char tmpbuf[128]; + d = scan_word(s, tmpbuf, TRUE, &len); + if (strchr(tmpbuf, ':')) + sv_setpv(subname, tmpbuf); + else { + sv_setsv(subname,curstname); + sv_catpvn(subname,"'",1); + sv_catpvn(subname,tmpbuf,len); + } + s = force_word(s,WORD,FALSE,TRUE); } else sv_setpv(subname,"?"); @@ -2318,6 +2535,9 @@ yylex() case KEY_telldir: UNI(OP_TELLDIR); + case KEY_tie: + LOP(OP_TIE); + case KEY_time: FUN0(OP_TIME); @@ -2333,6 +2553,9 @@ yylex() case KEY_ucfirst: UNI(OP_UCFIRST); + case KEY_untie: + UNI(OP_UNTIE); + case KEY_until: yylval.ival = curcop->cop_line; OPERATOR(UNTIL); @@ -2415,9 +2638,19 @@ I32 len; } break; case 'a': - if (strEQ(d,"alarm")) return KEY_alarm; - if (strEQ(d,"accept")) return KEY_accept; - if (strEQ(d,"atan2")) return KEY_atan2; + switch (len) { + case 3: + if (strEQ(d,"and")) return KEY_and; + if (strEQ(d,"abs")) return KEY_abs; + break; + case 5: + if (strEQ(d,"alarm")) return KEY_alarm; + if (strEQ(d,"atan2")) return KEY_atan2; + break; + case 6: + if (strEQ(d,"accept")) return KEY_accept; + break; + } break; case 'B': if (strEQ(d,"BEGIN")) return KEY_BEGIN; @@ -2431,6 +2664,7 @@ I32 len; switch (len) { case 3: if (strEQ(d,"cmp")) return KEY_cmp; + if (strEQ(d,"chr")) return KEY_chr; if (strEQ(d,"cos")) return KEY_cos; break; case 4: @@ -2600,6 +2834,7 @@ I32 len; else if (*d == 'l') { if (strEQ(d,"login")) return KEY_getlogin; } + else if (strEQ(d,"c")) return KEY_getc; break; } switch (len) { @@ -2610,7 +2845,6 @@ I32 len; case 4: if (strEQ(d,"grep")) return KEY_grep; if (strEQ(d,"goto")) return KEY_goto; - if (strEQ(d,"getc")) return KEY_getc; if (strEQ(d,"glob")) return KEY_glob; break; case 6: @@ -2706,6 +2940,9 @@ I32 len; break; case 'o': switch (len) { + case 2: + if (strEQ(d,"or")) return KEY_or; + break; case 3: if (strEQ(d,"ord")) return KEY_ord; if (strEQ(d,"oct")) return KEY_oct; @@ -2893,6 +3130,9 @@ I32 len; case 2: if (strEQ(d,"tr")) return KEY_tr; break; + case 3: + if (strEQ(d,"tie")) return KEY_tie; + break; case 4: if (strEQ(d,"tell")) return KEY_tell; if (strEQ(d,"time")) return KEY_time; @@ -2916,6 +3156,7 @@ I32 len; case 5: if (strEQ(d,"undef")) return KEY_undef; if (strEQ(d,"until")) return KEY_until; + if (strEQ(d,"untie")) return KEY_untie; if (strEQ(d,"utime")) return KEY_utime; if (strEQ(d,"umask")) return KEY_umask; break; @@ -2972,7 +3213,7 @@ char *what; { char *w; - if (dowarn && *s == ' ' && s[1] == '(') { + if (dowarn && *s == ' ' && s[1] == '(') { /* XXX gotta be a better way */ w = strchr(s,')'); if (w) for (w++; *w && isSPACE(*w); w++) ; @@ -2992,15 +3233,41 @@ char *what; while (s < bufend && isSPACE(*s)) s++; if (*s == ',') { + int kw; *s = '\0'; - w = instr( - "tell eof times getlogin wait length shift umask getppid \ - cos exp int log rand sin sqrt ord wantarray", - w); + kw = keyword(w, s - w); *s = ','; - if (w) + if (kw) return; - fatal("No comma allowed after %s", what); + croak("No comma allowed after %s", what); + } + } +} + +char * +scan_word(s, dest, allow_package, slp) +register char *s; +char *dest; +int allow_package; +STRLEN *slp; +{ + register char *d = dest; + for (;;) { + if (isALNUM(*s)) + *d++ = *s++; + else if (*s == '\'' && allow_package && isIDFIRST(s[1])) { + *d++ = ':'; + *d++ = ':'; + s++; + } + else if (*s == ':' && s[1] == ':' && allow_package && isIDFIRST(s[2])) { + *d++ = *s++; + *d++ = *s++; + } + else { + *d = '\0'; + *slp = d - dest; + return s; } } } @@ -3024,11 +3291,22 @@ I32 ck_uni; *d++ = *s++; } else { - while (isALNUM(*s) || *s == '\'') - *d++ = *s++; + for (;;) { + if (isALNUM(*s)) + *d++ = *s++; + else if (*s == '\'' && isIDFIRST(s[1])) { + *d++ = ':'; + *d++ = ':'; + s++; + } + else if (*s == ':' && s[1] == ':' && isIDFIRST(s[2])) { + *d++ = *s++; + *d++ = *s++; + } + else + break; + } } - while (d > dest+1 && d[-1] == '\'') - d--,s--; *d = '\0'; d = dest; if (*d) { @@ -3061,7 +3339,7 @@ I32 ck_uni; *d = '\0'; if (*s == '[' || *s == '{') { if (lex_brackets) - fatal("Can't use delimiter brackets within expression"); + croak("Can't use delimiter brackets within expression"); lex_fakebrack = TRUE; bracket++; lex_brackets++; @@ -3102,7 +3380,7 @@ I32 len; tmpstr = NEWSV(86,len); sv_upgrade(tmpstr, SVt_PVBM); sv_setpvn(tmpstr,string,len); - t = SvPVn(tmpstr); + t = SvPVX(tmpstr); e = t + len; BmUSEFUL(tmpstr) = 100; for (d=t; d < e; ) { @@ -3182,7 +3460,7 @@ char *start; if (lex_stuff) sv_free(lex_stuff); lex_stuff = Nullsv; - fatal("Search pattern not terminated"); + croak("Search pattern not terminated"); } pm = (PMOP*)newPMOP(OP_MATCH, 0); if (*start == '?') @@ -3226,7 +3504,7 @@ char *start; if (lex_stuff) sv_free(lex_stuff); lex_stuff = Nullsv; - fatal("Substitution pattern not terminated"); + croak("Substitution pattern not terminated"); } if (s[-1] == *start) @@ -3240,7 +3518,7 @@ char *start; if (lex_repl) sv_free(lex_repl); lex_repl = Nullsv; - fatal("Substitution replacement not terminated"); + croak("Substitution replacement not terminated"); } pm = (PMOP*)newPMOP(OP_SUBST, 0); @@ -3267,11 +3545,9 @@ char *start; if (es) { SV *repl; pm->op_pmflags |= PMf_EVAL; - repl = NEWSV(93,0); - while (es-- > 0) { - es--; + repl = newSVpv("",0); + while (es-- > 0) sv_catpvn(repl, "eval ", 5); - } sv_catpvn(repl, "{ ", 2); sv_catsv(repl, lex_repl); sv_catpvn(repl, " };", 2); @@ -3341,7 +3617,7 @@ char *start; if (lex_stuff) sv_free(lex_stuff); lex_stuff = Nullsv; - fatal("Translation pattern not terminated"); + croak("Translation pattern not terminated"); } if (s[-1] == *start) s--; @@ -3354,7 +3630,7 @@ char *start; if (lex_repl) sv_free(lex_repl); lex_repl = Nullsv; - fatal("Translation replacement not terminated"); + croak("Translation replacement not terminated"); } New(803,tbl,256,short); @@ -3435,14 +3711,14 @@ register char *s; } if (s >= bufend) { curcop->cop_line = multi_start; - fatal("EOF in string"); + croak("EOF in string"); } sv_setpvn(tmpstr,d+1,s-d); s += len - 1; sv_catpvn(herewas,s,bufend-s); sv_setsv(linestr,herewas); - oldoldbufptr = oldbufptr = bufptr = s = SvPVn(linestr); - bufend = SvPV(linestr) + SvCUR(linestr); + oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); } else sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */ @@ -3450,7 +3726,7 @@ register char *s; if (!rsfp || !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) { curcop->cop_line = multi_start; - fatal("EOF in string"); + croak("EOF in string"); } curcop->cop_line++; if (perldb) { @@ -3461,12 +3737,12 @@ register char *s; av_store(GvAV(curcop->cop_filegv), (I32)curcop->cop_line,sv); } - bufend = SvPV(linestr) + SvCUR(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); if (*s == term && bcmp(s,tokenbuf,len) == 0) { s = bufend - 1; *s = ' '; sv_catsv(linestr,herewas); - bufend = SvPV(linestr) + SvCUR(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); } else { s = bufend; @@ -3477,7 +3753,7 @@ register char *s; s++; if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) { SvLEN_set(tmpstr, SvCUR(tmpstr) + 1); - Renew(SvPV(tmpstr), SvLEN(tmpstr), char); + Renew(SvPVX(tmpstr), SvLEN(tmpstr), char); } sv_free(herewas); lex_stuff = tmpstr; @@ -3498,7 +3774,7 @@ char *start; if (s < bufend) s++; else - fatal("Unterminated <> operator"); + croak("Unterminated <> operator"); if (*d == '$') d++; while (*d && (isALNUM(*d) || *d == '\'')) @@ -3508,7 +3784,7 @@ char *start; set_csh(); s = scan_str(start); if (!s) - fatal("Glob not terminated"); + croak("Glob not terminated"); return s; } else { @@ -3564,9 +3840,11 @@ char *start; s++; for (;;) { SvGROW(sv, SvCUR(sv) + (bufend - s) + 1); - to = SvPV(sv)+SvCUR(sv); + to = SvPVX(sv)+SvCUR(sv); if (multi_open == multi_close) { for (; s < bufend; s++,to++) { + if (*s == '\n' && !rsfp) + curcop->cop_line++; if (*s == '\\' && s+1 < bufend && term != '\\') *to++ = *s++; else if (*s == term) @@ -3576,6 +3854,8 @@ char *start; } else { for (; s < bufend; s++,to++) { + if (*s == '\n' && !rsfp) + curcop->cop_line++; if (*s == '\\' && s+1 < bufend && term != '\\') *to++ = *s++; else if (*s == term && --brackets <= 0) @@ -3586,7 +3866,7 @@ char *start; } } *to = '\0'; - SvCUR_set(sv, to - SvPV(sv)); + SvCUR_set(sv, to - SvPVX(sv)); if (s < bufend) break; /* string ends on this line? */ @@ -3604,13 +3884,13 @@ char *start; av_store(GvAV(curcop->cop_filegv), (I32)curcop->cop_line, sv); } - bufend = SvPV(linestr) + SvCUR(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); } multi_end = curcop->cop_line; s++; if (SvCUR(sv) + 5 < SvLEN(sv)) { SvLEN_set(sv, SvCUR(sv) + 1); - Renew(SvPV(sv), SvLEN(sv), char); + Renew(SvPVX(sv), SvLEN(sv), char); } if (lex_stuff) lex_repl = sv; @@ -3633,7 +3913,7 @@ char *start; switch (*s) { default: - fatal("panic: scan_num"); + croak("panic: scan_num"); case '0': { U32 i; @@ -3739,7 +4019,7 @@ register char *s; { register char *eol; register char *t; - SV *stuff = NEWSV(0,0); + SV *stuff = newSV(0); bool needargs = FALSE; while (!needargs) { @@ -3755,7 +4035,7 @@ register char *s; eol = bufend; } else - eol = bufend = SvPV(linestr) + SvCUR(linestr); + eol = bufend = SvPVX(linestr) + SvCUR(linestr); if (*s != '#') { sv_catpvn(stuff, s, eol-s); while (s < eol) { @@ -3769,16 +4049,17 @@ register char *s; s = eol; if (rsfp) { s = sv_gets(linestr, rsfp, 0); - oldoldbufptr = oldbufptr = bufptr = SvPVn(linestr); + oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr); if (!s) { s = bufptr; yyerror("Format not terminated"); break; } } - curcop->cop_line++; + incline(s); } if (SvPOK(stuff)) { + expect = XTERM; if (needargs) { nextval[nexttoke].ival = 0; force_next(','); @@ -3806,3 +4087,56 @@ set_csh() cshlen = strlen(cshname); #endif } + +int +yyerror(s) +char *s; +{ + char tmpbuf[258]; + char tmp2buf[258]; + char *tname = tmpbuf; + + if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 && + oldoldbufptr != oldbufptr && oldbufptr != bufptr) { + while (isSPACE(*oldoldbufptr)) + oldoldbufptr++; + cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr); + sprintf(tname,"near \"%s\"",tmp2buf); + } + else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 && + oldbufptr != bufptr) { + while (isSPACE(*oldbufptr)) + oldbufptr++; + cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr); + sprintf(tname,"near \"%s\"",tmp2buf); + } + else if (yychar > 255) + tname = "next token ???"; + else if (!yychar || (yychar == ';' && !rsfp)) + (void)strcpy(tname,"at EOF"); + else if ((yychar & 127) == 127) { + if (lex_state == LEX_NORMAL || + (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL)) + (void)strcpy(tname,"at end of line"); + else + (void)strcpy(tname,"at end of string"); + } + else if (yychar < 32) + (void)sprintf(tname,"next char ^%c",yychar+64); + else + (void)sprintf(tname,"next char %c",yychar); + (void)sprintf(buf, "%s at %s line %d, %s\n", + s,SvPVX(GvSV(curcop->cop_filegv)),curcop->cop_line,tname); + if (curcop->cop_line == multi_end && multi_start < multi_end) + sprintf(buf+strlen(buf), + " (Might be a runaway multi-line %c%c string starting on line %d)\n", + multi_open,multi_close,multi_start); + if (in_eval) + sv_catpv(GvSV(gv_fetchpv("@",TRUE)),buf); + else + fputs(buf,stderr); + if (++error_count >= 10) + croak("%s has too many errors.\n", + SvPVX(GvSV(curcop->cop_filegv))); + return 0; +} @@ -85,7 +85,7 @@ VOID (*func)(); if (pipe(p) < 0) { fclose( fil ); - fatal("Can't get pipe for decrypt"); + croak("Can't get pipe for decrypt"); } /* make sure that the child doesn't get anything extra */ @@ -97,7 +97,7 @@ VOID (*func)(); close(p[0]); close(p[1]); fclose( fil ); - fatal("Can't fork for decrypt"); + croak("Can't fork for decrypt"); } sleep(5); } @@ -132,12 +132,12 @@ cryptswitch() ch = getc(rsfp); if (ch == CRYPT_MAGIC_1) { if (getc(rsfp) == CRYPT_MAGIC_2) { - if( perldb ) fatal("can't debug an encrypted script"); + if( perldb ) croak("can't debug an encrypted script"); rsfp = my_pfiopen( rsfp, cryptfilter ); preprocess = 1; /* force call to pclose when done */ } else - fatal( "bad encryption run_format" ); + croak( "bad encryption run_format" ); } else ungetc(ch,rsfp); diff --git a/usub/usersub.c b/usub/usersub.c deleted file mode 100644 index 6f648fda40..0000000000 --- a/usub/usersub.c +++ /dev/null @@ -1,74 +0,0 @@ -/* $RCSfile: usersub.c,v $$Revision: 4.1 $$Date: 92/08/07 18:28:59 $ - * - * $Log: usersub.c,v $ - * Revision 4.1 92/08/07 18:28:59 lwall - * - * Revision 4.0.1.1 91/11/05 19:07:24 lwall - * patch11: there are now subroutines for calling back from C into Perl - * - * Revision 4.0 91/03/20 01:56:34 lwall - * 4.0 baseline. - * - * Revision 3.0.1.1 90/08/09 04:06:10 lwall - * patch19: Initial revision - * - */ - -#include "EXTERN.h" -#include "perl.h" - -int -userinit() -{ - init_curses(); -} - -/* Be sure to refetch the stack pointer after calling these routines. */ - -int -callback(subname, sp, gimme, hasargs, numargs) -char *subname; -int sp; /* stack pointer after args are pushed */ -int gimme; /* called in array or scalar context */ -int hasargs; /* whether to create a @_ array for routine */ -int numargs; /* how many args are pushed on the stack */ -{ - static ARG myarg[3]; /* fake syntax tree node */ - int arglast[3]; - - arglast[2] = sp; - sp -= numargs; - arglast[1] = sp--; - arglast[0] = sp; - - if (!myarg[0].arg_ptr.arg_str) - myarg[0].arg_ptr.arg_str = str_make("",0); - - myarg[1].arg_type = A_WORD; - myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE); - - myarg[2].arg_type = hasargs ? A_EXPR : A_NULL; - - return do_subr(myarg, gimme, arglast); -} - -int -callv(subname, sp, gimme, argv) -char *subname; -register int sp; /* current stack pointer */ -int gimme; /* called in array or scalar context */ -register char **argv; /* null terminated arg list, NULL for no arglist */ -{ - register int items = 0; - int hasargs = (argv != 0); - - astore(stack, ++sp, Nullstr); /* reserve spot for 1st return arg */ - if (hasargs) { - while (*argv) { - astore(stack, ++sp, str_2mortal(str_make(*argv,0))); - items++; - argv++; - } - } - return callback(subname, sp, gimme, hasargs, items); -} @@ -98,7 +98,7 @@ MEM_SIZE size; #endif /* MSDOS */ #ifdef DEBUGGING if ((long)size < 0) - fatal("panic: malloc"); + croak("panic: malloc"); #endif ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */ #if !(defined(I286) || defined(atarist)) @@ -140,10 +140,10 @@ unsigned long size; } #endif /* MSDOS */ if (!where) - fatal("Null realloc"); + croak("Null realloc"); #ifdef DEBUGGING if ((long)size < 0) - fatal("panic: realloc"); + croak("panic: realloc"); #endif ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */ @@ -384,13 +384,13 @@ I32 iflag; U32 frequency = 256; Sv_Grow(sv,len+258); - table = (unsigned char*)(SvPV(sv) + len + 1); + table = (unsigned char*)(SvPVX(sv) + len + 1); s = table - 2; for (i = 0; i < 256; i++) { table[i] = len; } i = 0; - while (s >= (unsigned char*)(SvPV(sv))) + while (s >= (unsigned char*)(SvPVX(sv))) { if (table[*s] == len) { #ifndef pdp11 @@ -413,7 +413,7 @@ I32 iflag; sv_magic(sv, 0, 'B', 0, 0); /* deep magic */ SvVALID_on(sv); - s = (unsigned char*)(SvPV(sv)); /* deeper magic */ + s = (unsigned char*)(SvPVX(sv)); /* deeper magic */ if (iflag) { register U32 tmp, foldtmp; SvCASEFOLD_on(sv); @@ -455,17 +455,17 @@ SV *littlestr; register unsigned char *oldlittle; if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) { - if (!SvPOK(littlestr) || !SvPV(littlestr)) + if (!SvPOK(littlestr) || !SvPVX(littlestr)) return (char*)big; return ninstr((char*)big,(char*)bigend, - SvPV(littlestr), SvPV(littlestr) + SvCUR(littlestr)); + SvPVX(littlestr), SvPVX(littlestr) + SvCUR(littlestr)); } littlelen = SvCUR(littlestr); if (SvTAIL(littlestr) && !multiline) { /* tail anchored? */ if (littlelen > bigend - big) return Nullch; - little = (unsigned char*)SvPV(littlestr); + little = (unsigned char*)SvPVX(littlestr); if (SvCASEFOLD(littlestr)) { /* oops, fake it */ big = bigend - littlelen; /* just start near end */ if (bigend[-1] == '\n' && little[littlelen-1] != '\n') @@ -484,7 +484,7 @@ SV *littlestr; return Nullch; } } - table = (unsigned char*)(SvPV(littlestr) + littlelen + 1); + table = (unsigned char*)(SvPVX(littlestr) + littlelen + 1); if (--littlelen >= bigend - big) return Nullch; s = big + littlelen; @@ -572,11 +572,11 @@ SV *littlestr; if ((pos = screamfirst[BmRARE(littlestr)]) < 0) return Nullch; - little = (unsigned char *)(SvPV(littlestr)); + little = (unsigned char *)(SvPVX(littlestr)); littleend = little + SvCUR(littlestr); first = *little++; previous = BmPREVIOUS(littlestr); - big = (unsigned char *)(SvPV(bigstr)); + big = (unsigned char *)(SvPVX(bigstr)); bigend = big + SvCUR(bigstr); while (pos < previous) { if (!(pos += screamnext[pos])) @@ -737,7 +737,7 @@ long a1, a2, a3, a4; if (usermess) { tmpstr = sv_mortalcopy(&sv_undef); sv_setpv(tmpstr, (char*)a1); - *s++ = SvPV(tmpstr)[SvCUR(tmpstr)-1]; + *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1]; } else { (void)sprintf(s,pat,a1,a2,a3,a4); @@ -747,7 +747,7 @@ long a1, a2, a3, a4; if (s[-1] != '\n') { if (curcop->cop_line) { (void)sprintf(s," at %s line %ld", - SvPV(GvSV(curcop->cop_filegv)), (long)curcop->cop_line); + SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line); s += strlen(s); } if (last_in_gv && @@ -764,13 +764,13 @@ long a1, a2, a3, a4; sv_catpv(tmpstr,buf+1); } if (usermess) - return SvPV(tmpstr); + return SvPVX(tmpstr); else return buf; } /*VARARGS1*/ -void fatal(pat,a1,a2,a3,a4) +void croak(pat,a1,a2,a3,a4) char *pat; long a1, a2, a3, a4; { @@ -778,7 +778,6 @@ long a1, a2, a3, a4; char *message; message = mess(pat,a1,a2,a3,a4); - XXX fputs(message,stderr); (void)fflush(stderr); if (e_fp) @@ -825,7 +824,7 @@ va_list args; if (usermess) { tmpstr = sv_mortalcopy(&sv_undef); sv_setpv(tmpstr, va_arg(args, char *)); - *s++ = SvPV(tmpstr)[SvCUR(tmpstr)-1]; + *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1]; } else { (void) vsprintf(s,pat,args); @@ -835,7 +834,7 @@ va_list args; if (s[-1] != '\n') { if (curcop->cop_line) { (void)sprintf(s," at %s line %ld", - SvPV(GvSV(curcop->cop_filegv)), (long)curcop->cop_line); + SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line); s += strlen(s); } if (last_in_gv && @@ -853,15 +852,19 @@ va_list args; } if (usermess) - return SvPV(tmpstr); + return SvPVX(tmpstr); else return buf; } /*VARARGS0*/ void -fatal(va_alist) +#ifdef __STDC__ +croak(char* pat,...) +#else +croak(va_alist) va_dcl +#endif { va_list args; char *tmps; @@ -881,8 +884,12 @@ va_dcl } /*VARARGS0*/ +#ifdef __STDC__ +void warn(char* pat,...) +#else void warn(va_alist) va_dcl +#endif { va_list args; char *message; @@ -1104,7 +1111,7 @@ register long l; return u.result; #else #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf) - fatal("Unknown BYTEORDER\n"); + croak("Unknown BYTEORDER\n"); #else register I32 o; register I32 s; @@ -1134,7 +1141,7 @@ register long l; return u.l; #else #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf) - fatal("Unknown BYTEORDER\n"); + croak("Unknown BYTEORDER\n"); #else register I32 o; register I32 s; @@ -1225,17 +1232,17 @@ char *mode; return Nullfp; this = (*mode == 'w'); that = !this; -#ifdef TAINT - if (doexec) { - taint_env(); - TAINT_PROPER("exec"); + if (tainting) { + if (doexec) { + taint_env(); + taint_proper("Insecure %s%s", "EXEC"); + } } -#endif while ((pid = (doexec?vfork():fork())) < 0) { if (errno != EAGAIN) { close(p[this]); if (!doexec) - fatal("Can't fork"); + croak("Can't fork"); return Nullfp; } sleep(5); @@ -1265,10 +1272,10 @@ char *mode; _exit(1); } /*SUPPRESS 560*/ - if (tmpgv = gv_fetchpv("$",allgvs)) + if (tmpgv = gv_fetchpv("$",TRUE)) sv_setiv(GvSV(tmpgv),(I32)getpid()); forkprocess = 0; - hv_clear(pidstatus, FALSE); /* we have no children */ + hv_clear(pidstatus); /* we have no children */ return Nullfp; #undef THIS #undef THAT @@ -1282,7 +1289,7 @@ char *mode; } sv = *av_fetch(fdpid,p[this],TRUE); SvUPGRADE(sv,SVt_IV); - SvIV(sv) = pid; + SvIVX(sv) = pid; forkprocess = pid; return fdopen(p[this], mode); } @@ -1355,7 +1362,7 @@ FILE *ptr; int pid; sv = *av_fetch(fdpid,fileno(ptr),TRUE); - pid = SvIV(sv); + pid = SvIVX(sv); av_store(fdpid,fileno(ptr),Nullsv); fclose(ptr); #ifdef UTS @@ -1388,7 +1395,7 @@ int flags; sprintf(spid, "%d", pid); svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE); if (svp && *svp != &sv_undef) { - *statusp = SvIV(*svp); + *statusp = SvIVX(*svp); hv_delete(pidstatus,spid,strlen(spid)); return pid; } @@ -1400,7 +1407,7 @@ int flags; if (entry = hv_iternext(pidstatus)) { pid = atoi(hv_iterkey(entry,statusp)); sv = hv_iterval(pidstatus,entry); - *statusp = SvIV(sv); + *statusp = SvIVX(sv); sprintf(spid, "%d", pid); hv_delete(pidstatus,spid,strlen(spid)); return pid; @@ -1413,7 +1420,7 @@ int flags; return waitpid(pid,statusp,flags); #else if (flags) - fatal("Can't do waitpid with flags"); + croak("Can't do waitpid with flags"); else { while ((result = wait(statusp)) != pid && pid > 0 && result >= 0) pidgone(result,*statusp); @@ -1438,7 +1445,7 @@ int status; sprintf(spid, "%d", pid); sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE); SvUPGRADE(sv,SVt_IV); - SvIV(sv) = status; + SvIVX(sv) = status; return; } @@ -1477,7 +1484,7 @@ register I32 count; } #ifndef CASTNEGFLOAT -unsigned long +U32 cast_ulong(f) double f; { @@ -171,7 +171,7 @@ term : variable { $$ = oper2(OPOW,$1,$3); } | term IN VAR { $$ = oper2(ODEFINED,aryrefarg($3),$1); } - | term '?' term ':' term + | cond '?' expr ':' expr { $$ = oper3(OCOND,$1,$3,$5); } | variable INCR { $$ = oper1(OPOSTINCR,$1); } diff --git a/x2p/find2perl.SH b/x2p/find2perl.SH index 582a9924ad..541f2629d3 100755 --- a/x2p/find2perl.SH +++ b/x2p/find2perl.SH @@ -122,7 +122,7 @@ while (@ARGV) { $out .= &tab . '($ino ' . &n(shift); } elsif ($_ eq 'size') { - $out .= &tab . '(int((-s _ + 511) / 512) ' . &n(shift); + $out .= &tab . '(int(((-s _) + 511) / 512) ' . &n(shift); } elsif ($_ eq 'atime') { $out .= &tab . '(int(-A _) ' . &n(shift); |