perl 5.0 alpha 4
authorLarry Wall <larry@netlabs.com>
Wed, 10 Nov 1993 00:00:00 +0000 (00:00 +0000)
committerLarry Wall <larry@netlabs.com>
Wed, 10 Nov 1993 00:00:00 +0000 (00:00 +0000)
[editor's note: the sparc executables have not been included, and
emacs backup files have been removed.  This was reconstructed from a
tarball found on the September 1994 InfoMagic CD; the date of this is
approximate]

213 files changed:
Artistic
Bugs/assignglob [deleted file]
Bugs/crash1 [deleted file]
Bugs/crash2 [deleted file]
Bugs/pagdir [changed mode: 0644->0755]
Bugs/replacecase [deleted file]
Bugs/shiftref [new file with mode: 0755]
Bugs/stuff [deleted file]
Changes
MANIFEST
NDBM_File.c [new file with mode: 0644]
ODBM_File.c [new file with mode: 0644]
SDBM_File.c [new file with mode: 0644]
Todo
Wishlist [deleted file]
XSUB.h [new file with mode: 0644]
av.c
av.h
bar
config.sh
cop.h
deb.c
do/accept [deleted file]
do/aexec [deleted file]
do/aprint [deleted file]
do/assign [deleted file]
do/bind [deleted file]
do/caller [deleted file]
do/chop [deleted file]
do/close [deleted file]
do/connect [deleted file]
do/ctl [deleted file]
do/defined [deleted file]
do/dirop [deleted file]
do/each [deleted file]
do/eof [deleted file]
do/exec [deleted file]
do/execfree [deleted file]
do/fttext [deleted file]
do/getsockname [deleted file]
do/ggrent [deleted file]
do/ghent [deleted file]
do/gnent [deleted file]
do/gpent [deleted file]
do/gpwent [deleted file]
do/grep [deleted file]
do/gsent [deleted file]
do/ipcctl [deleted file]
do/ipcget [deleted file]
do/join [deleted file]
do/kv [deleted file]
do/listen [deleted file]
do/match [deleted file]
do/msgrcv [deleted file]
do/msgsnd [deleted file]
do/open [deleted file]
do/pack [deleted file]
do/pipe [deleted file]
do/print [deleted file]
do/push [deleted file]
do/range [deleted file]
do/repeatary [deleted file]
do/reverse [deleted file]
do/seek [deleted file]
do/select [deleted file]
do/semop [deleted file]
do/shmio [deleted file]
do/shutdown [deleted file]
do/slice [deleted file]
do/socket [deleted file]
do/sopt [deleted file]
do/sort [deleted file]
do/spair [deleted file]
do/splice [deleted file]
do/split [deleted file]
do/sprintf [deleted file]
do/sreverse [deleted file]
do/stat [deleted file]
do/study [deleted file]
do/subr [deleted file]
do/subst [deleted file]
do/syscall [deleted file]
do/tell [deleted file]
do/time [deleted file]
do/tms [deleted file]
do/trans [deleted file]
do/truncate [deleted file]
do/undef [deleted file]
do/unpack [deleted file]
do/unshift [deleted file]
do/vec [deleted file]
do/vecset [deleted file]
do/vop [deleted file]
doio.c
dolist.c [deleted file]
doop.c
doop.c2 [deleted file]
dump.c
emacs/cperl-mode [new file with mode: 0644]
emacs/emacs19 [new file with mode: 0644]
embed.h
embed_h.SH
ext/README [moved from usub/README with 100% similarity]
ext/curses/Makefile [moved from usub/Makefile with 100% similarity]
ext/curses/bsdcurses.mus [moved from usub/bsdcurses.mus with 100% similarity]
ext/curses/curses.mus [moved from usub/curses.mus with 100% similarity]
ext/curses/pager [moved from usub/pager with 100% similarity]
ext/dbm/GDBM_File.c [new file with mode: 0644]
ext/dbm/GDBM_File.xs [new file with mode: 0644]
ext/dbm/GDBM_File.xs.bak [new file with mode: 0644]
ext/dbm/Makefile [new file with mode: 0644]
ext/dbm/NDBM_File.c [new file with mode: 0644]
ext/dbm/NDBM_File.xs [new file with mode: 0644]
ext/dbm/ODBM_File.c [new file with mode: 0644]
ext/dbm/ODBM_File.xs [new file with mode: 0644]
ext/dbm/SDBM_File.c [new file with mode: 0644]
ext/dbm/SDBM_File.xs [new file with mode: 0644]
ext/dbm/sdbm/.pure [new file with mode: 0644]
ext/dbm/sdbm/.r [new file with mode: 0755]
ext/dbm/sdbm/CHANGES [new file with mode: 0644]
ext/dbm/sdbm/COMPARE [new file with mode: 0644]
ext/dbm/sdbm/README [new file with mode: 0644]
ext/dbm/sdbm/README.too [new file with mode: 0644]
ext/dbm/sdbm/biblio [new file with mode: 0644]
ext/dbm/sdbm/dba.c [new file with mode: 0644]
ext/dbm/sdbm/dbd.c [new file with mode: 0644]
ext/dbm/sdbm/dbe.1 [new file with mode: 0644]
ext/dbm/sdbm/dbe.c [new file with mode: 0644]
ext/dbm/sdbm/dbm.c [new file with mode: 0644]
ext/dbm/sdbm/dbm.h [new file with mode: 0644]
ext/dbm/sdbm/dbu.c [new file with mode: 0644]
ext/dbm/sdbm/grind [new file with mode: 0755]
ext/dbm/sdbm/hash.c [new file with mode: 0644]
ext/dbm/sdbm/linux.patches [new file with mode: 0644]
ext/dbm/sdbm/makefile [new file with mode: 0644]
ext/dbm/sdbm/pair.c [new file with mode: 0644]
ext/dbm/sdbm/pair.h [new file with mode: 0644]
ext/dbm/sdbm/readme.ms [new file with mode: 0644]
ext/dbm/sdbm/readme.ps [new file with mode: 0644]
ext/dbm/sdbm/sdbm.3 [new file with mode: 0644]
ext/dbm/sdbm/sdbm.c [new file with mode: 0644]
ext/dbm/sdbm/sdbm.h [new file with mode: 0644]
ext/dbm/sdbm/tune.h [new file with mode: 0644]
ext/dbm/sdbm/util.c [new file with mode: 0644]
ext/man2mus [moved from usub/man2mus with 100% similarity]
ext/mus [moved from usub/mus with 100% similarity]
ext/posix/POSIX.xs [new file with mode: 0644]
ext/typemap [moved from usub/typemap with 95% similarity]
ext/xsubpp [moved from usub/tus with 71% similarity]
ext/xsubpp.bak [new file with mode: 0755]
ext/xvarpp [moved from usub/tuv with 89% similarity]
fixmac [new file with mode: 0755]
fo [new file with mode: 0755]
foo
functab.h,v [deleted file]
global.var
gv.c
gv.h
h2ph
hints/aix_rs.sh
hv.c
hv.h
hvdbm.h [new file with mode: 0644]
interp.var
keywords.h
lib/hostname.pl [new file with mode: 0644]
lib/open3.pl
lib/timelocal.pl
lib/verbose.pl [new file with mode: 0644]
main.c
make.out
makefile
malloc.c
mg.c
mg.h
net [deleted symlink]
op.c
op.h
opcode.h
opcode.pl
perl.c
perl.h
perl.man
perly.c
perly.h
perly.y
pp.c
pp.h
proto.h
regcomp.c
regcomp.h
regexec.c
run.c
scope.c
sv.c
sv.h
t/comp/cmdopt.t
t/comp/package.t
t/op/dbm.t
t/op/ord.t
t/op/sort.t
t/op/time.t
t/op/write.t
taint.c
tiearray [new file with mode: 0755]
tiedbm [new file with mode: 0755]
tiescalar [new file with mode: 0755]
toke.c
usersub.c
usub/usersub.c [deleted file]
util.c
x2p/a2p.y
x2p/find2perl.SH

index a27fd48..11f4d82 100644 (file)
--- a/Artistic
+++ b/Artistic
@@ -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 (executable)
index f36e9e2..0000000
+++ /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 (executable)
index 7e6eff7..0000000
+++ /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 (file)
index c726e2e..0000000
+++ /dev/null
@@ -1 +0,0 @@
-sleep(1) &sort
old mode 100644 (file)
new mode 100755 (executable)
diff --git a/Bugs/replacecase b/Bugs/replacecase
deleted file mode 100644 (file)
index 795ea9d..0000000
+++ /dev/null
@@ -1 +0,0 @@
-s/\w/[\u$&\l$&]/gi;
diff --git a/Bugs/shiftref b/Bugs/shiftref
new file mode 100755 (executable)
index 0000000..e4ab0c5
--- /dev/null
@@ -0,0 +1 @@
+shift->[0]
diff --git a/Bugs/stuff b/Bugs/stuff
deleted file mode 100644 (file)
index 3337af0..0000000
+++ /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
-
-
diff --git a/Changes b/Changes
index b8fb52f..9941ea0 100644 (file)
--- a/Changes
+++ b/Changes
@@ -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.
+
index d0b9a4b..d0efb2e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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 (file)
index 0000000..3040534
--- /dev/null
@@ -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 (file)
index 0000000..7c5f780
--- /dev/null
@@ -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 (file)
index 0000000..23b8356
--- /dev/null
@@ -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);
+}
diff --git a/Todo b/Todo
index 3393a7f..f561af4 100755 (executable)
--- a/Todo
+++ b/Todo
@@ -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 (file)
index 4afb4f8..0000000
--- 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 (file)
index 0000000..764b8e6
--- /dev/null
+++ b/XSUB.h
@@ -0,0 +1 @@
+#define ST(s) stack_base[sp + s]
diff --git a/av.c b/av.c
index ee7a30a..822f935 100644 (file)
--- a/av.c
+++ b/av.c
 #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);
     }
 }
diff --git a/av.h b/av.h
index 40f2eb2..42f5c85 100644 (file)
--- a/av.h
+++ b/av.h
  */
 
 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
diff --git a/bar b/bar
index 65f17df..43ada97 100755 (executable)
--- a/bar
+++ b/bar
@@ -1,5 +1,7 @@
 #!./perl
 
-sub foo;
-
-foo;
+$o = {A,1};
+$r = \($o->{A});
+print $$r;
+$$r = foo;
+print $$r;
index 896c10b..11f6c80 100644 (file)
--- a/config.sh
+++ b/config.sh
@@ -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=''
diff --git a/cop.h b/cop.h
index 8e7a88d..0b1868b 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -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 {
diff --git a/deb.c b/deb.c
index 2f5124c..0af6110 100644 (file)
--- a/deb.c
+++ b/deb.c
@@ -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 (file)
index dd0c203..0000000
--- 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 (file)
index d8f0dcf..0000000
--- 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 (file)
index bda86c8..0000000
--- 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 (file)
index 2799d02..0000000
--- 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 (file)
index d5f6690..0000000
--- 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 (file)
index cb921e5..0000000
--- 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 (file)
index 377d694..0000000
--- 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 (file)
index 2ddc142..0000000
--- 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 (file)
index 08230d2..0000000
+++ /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 (file)
index 543cea8..0000000
--- 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 (file)
index 2721f05..0000000
+++ /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 (file)
index 6f4c0b6..0000000
--- 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 (file)
index 7350126..0000000
--- 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 (file)
index a1512cd..0000000
--- 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 (file)
index 5aee9a2..0000000
--- 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 (file)
index 3f5bd39..0000000
+++ /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 (file)
index 6d6f288..0000000
--- 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 (file)
index b899400..0000000
+++ /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 (file)
index bf4a918..0000000
--- 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 (file)
index db4a570..0000000
--- 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 (file)
index 131e6fe..0000000
--- 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 (file)
index a5cc1c7..0000000
--- 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 (file)
index 522cb5b..0000000
--- 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 (file)
index 94598ab..0000000
--- 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 (file)
index ac70516..0000000
--- 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 (file)
index fb3e243..0000000
--- 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 (file)
index 8eed98e..0000000
--- 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 (file)
index c5c5220..0000000
--- 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 (file)
index e433393..0000000
--- 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 (file)
index 1ec7341..0000000
--- 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 (file)
index 9919776..0000000
--- 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 (file)
index d687664..0000000
--- 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 (file)
index 700a662..0000000
--- 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 (file)
index 339b3ba..0000000
--- 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 (file)
index 96e8bd5..0000000
--- 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 (file)
index b3a6216..0000000
--- 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 (file)
index ea3acc6..0000000
--- 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 (file)
index 8ff5b24..0000000
--- 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 (file)
index f28bcd7..0000000
--- 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 (file)
index 856a83d..0000000
+++ /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 (file)
index 32598ab..0000000
+++ /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 (file)
index c295ea7..0000000
--- 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 (file)
index 3821193..0000000
--- 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 (file)
index 9a4ec11..0000000
--- 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 (file)
index b710768..0000000
--- 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 (file)
index 1191707..0000000
+++ /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 (file)
index a55a69e..0000000
--- 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 (file)
index 08daa88..0000000
--- 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 (file)
index 439f3e2..0000000
--- 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 (file)
index e98981c..0000000
--- 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 (file)
index a32479f..0000000
--- 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 (file)
index 58aa56c..0000000
--- 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 (file)
index 904d29a..0000000
--- 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 (file)
index c4b9d9c..0000000
+++ /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 (file)
index bbf88b7..0000000
+++ /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 (file)
index d53f0ec..0000000
--- 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 (file)
index 14c2e06..0000000
--- 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 (file)
index 076fe96..0000000
--- 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 (file)
index 77dbde1..0000000
--- 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 (file)
index 51e65ba..0000000
+++ /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 (file)
index 11e6f83..0000000
--- 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 (file)
index dbe45ef..0000000
--- 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 (file)
index 78ad526..0000000
--- 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(&timesbuf);
-
-#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 (file)
index f4c5503..0000000
--- 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 (file)
index bf8306f..0000000
+++ /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 (file)
index 092341b..0000000
--- 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 (file)
index 81cca11..0000000
--- 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 (file)
index 26a3c78..0000000
+++ /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 (file)
index 37101ad..0000000
--- 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 (file)
index 60b8d52..0000000
--- 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 (file)
index d91ef53..0000000
--- 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;
-    }
-}
-
diff --git a/doio.c b/doio.c
index 73d8535..2b8bbf9 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -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--;
            }