perl 5.0 alpha 6
authorLarry Wall <larry@netlabs.com>
Fri, 18 Mar 1994 00:00:00 +0000 (00:00 +0000)
committerLarry Wall <larry@netlabs.com>
Fri, 18 Mar 1994 00:00:00 +0000 (00:00 +0000)
[editor's note: cleaned up from the September '94 InfoMagic CD, just
like the last commit]

112 files changed:
.package [new file with mode: 0644]
Bugs/amiga [new file with mode: 0644]
Bugs/delocalglob [new file with mode: 0755]
Bugs/f2p_prune [new file with mode: 0644]
Bugs/mislex [deleted file]
Bugs/pagdir [deleted file]
Bugs/shiftref [deleted file]
Changes
NDBM_File.c
ODBM_File.c
POSIX.c [new file with mode: 0644]
Quick [new file with mode: 0644]
SDBM_File.c
TCL [deleted file]
Todo
XSUB.h
av.c
bar [new file with mode: 0755]
bar.pm [new file with mode: 0755]
bench/fib [new file with mode: 0755]
cflags
configpm [new file with mode: 0755]
cop.h
cv.h
deb.c
dl.c [new file with mode: 0644]
doio.c
doop.c
dump.c
embed.h
embed_h.SH
eval.c.save [deleted file]
ext/dbm/GDBM_File.c
ext/dbm/Makefile
ext/dbm/ODBM_File.c
ext/dbm/SDBM_File.c
ext/dbm/sdbm/makefile
ext/dbm/typemap [new file with mode: 0644]
ext/dl/dl.c [new file with mode: 0644]
ext/dl/eg/Makefile [new file with mode: 0644]
ext/dl/eg/Makefile.att [new file with mode: 0644]
ext/dl/eg/main.c [new file with mode: 0644]
ext/dl/eg/test.c [new file with mode: 0644]
ext/dl/eg/test1.c [new file with mode: 0644]
ext/posix/POSIX.xs
ext/posix/typemap [new file with mode: 0644]
ext/typemap
ext/typemap.oi [new file with mode: 0644]
ext/typemap.xlib [new file with mode: 0644]
ext/typemap.xpm [new file with mode: 0644]
ext/xsubpp
fib [new file with mode: 0755]
foo
global.sym [moved from global.var with 95% similarity]
gv.c
gv.h
hv.c
interp.sym [moved from interp.var with 96% similarity]
keywords.h
lib/AutoLoader.pm [new file with mode: 0644]
lib/Config.pm [new file with mode: 0644]
lib/English.pm [new file with mode: 0644]
lib/Exporter.pm [new file with mode: 0644]
lib/FOOBAR.pm [new file with mode: 0644]
lib/FileHandle.pm [new file with mode: 0644]
lib/Hostname.pm [new file with mode: 0644]
lib/POSIX.pm [new file with mode: 0644]
lib/SDBM_File.pm [new file with mode: 0644]
lib/bigint.pl
lib/find.pl
lib/perldb.pl
lib/verbose.pl [deleted file]
main.c
make.out
makefile
malloc.c
mg.c
mg.h
op.c
opcode.h
opcode.pl
perl.c
perl.h
perl.man
perly.c
perly.c.diff
perly.h
perly.y
perly.y.save [deleted file]
pp.c
pp.h
proto.h
regcomp.c
regexec.c
run.c
save_ary.bad [new file with mode: 0644]
scope.c
scope.h
sv.c
sv.h
t/foo
t/foo.out [new file with mode: 0644]
t/lib/bigint.t [moved from t/lib/big.t with 98% similarity]
t/lib/english.t [new file with mode: 0755]
t/lib/sdbm.t [moved from t/op/dbm.t with 89% similarity]
t/op/goto.t
t/op/ref.t
taint.c
toke.c
trace.out [deleted file]
util.c
x2p/find2perl.SH

diff --git a/.package b/.package
new file mode 100644 (file)
index 0000000..a084d4f
--- /dev/null
+++ b/.package
@@ -0,0 +1,16 @@
+: basic variables
+package=perl
+baserev=4.1
+patchbranch=1
+mydiff='diff -c'
+maintname='Larry Wall'
+maintloc='lwall@netlabs.com'
+ftpsite=''
+orgname='NetLabs, Inc.'
+newsgroups='comp.lang.perl'
+recipients=''
+ftpdir=''
+
+: derivative variables--do not change
+revbranch="$baserev.$patchbranch"
+packver='1'
diff --git a/Bugs/amiga b/Bugs/amiga
new file mode 100644 (file)
index 0000000..fdf9101
--- /dev/null
@@ -0,0 +1,142 @@
+Article 38050 of comp.sys.amiga.programmer:
+Newsgroups: comp.sys.amiga.programmer
+Path: netlabs!news.cerf.net!usc!howland.reston.ans.net!pipex!uunet!majipoor.cygnus.com!fnf
+From: fnf@cygnus.com (Fred Fish)
+Subject: Re: FreshFish-dec93 CD; broken perl thereon
+Message-ID: <CKBuwv.7qF@cygnus.com>
+Organization: Cygnus Support, Mountain View, CA
+References: <1994Jan20.095600.8371@philips.oz.au> <D> <bruce.0r61@zuhause.mn.org>
+Date: Fri, 28 Jan 1994 06:48:29 GMT
+Lines: 129
+
+In article <bruce.0r61@zuhause.mn.org>,
+Bruce Albrecht <bruce@zuhause.MN.ORG> wrote:
+>In article <1994Jan20.095600.8371@philips.oz.au> gduncan@philips.oz.au (Gary Duncan) writes:
+>Me too.  I don't have the December Fresh Fish, so I can't comment on it,
+>but I have been wondering what it will take to do a fresh port of it anyway.
+
+The diffs that I applied to the base FSF distribution are:
+
+diff -rc perl-4.036-fsf/Configure perl-4.036-amiga/Configure
+*** perl-4.036-fsf/Configure   Mon Feb  8 20:37:48 1993
+--- perl-4.036-amiga/Configure Mon Sep 27 21:46:16 1993
+***************
+*** 4023,4029 ****
+      eval $ans;;
+  esac
+  chmod +x doSH
+! ./doSH
+  
+  if $contains '^depend:' [Mm]akefile >/dev/null 2>&1; then
+      dflt=n
+--- 4023,4029 ----
+      eval $ans;;
+  esac
+  chmod +x doSH
+! sh doSH
+  
+  if $contains '^depend:' [Mm]akefile >/dev/null 2>&1; then
+      dflt=n
+diff -rc perl-4.036-fsf/Makefile.SH perl-4.036-amiga/Makefile.SH
+*** perl-4.036-fsf/Makefile.SH Mon Feb  8 20:35:21 1993
+--- perl-4.036-amiga/Makefile.SH       Tue Sep 28 07:16:24 1993
+***************
+*** 349,355 ****
+  
+  test: perl
+       - cd t && chmod +x TEST */*.t
+!      - cd t && (rm -f perl; $(SLN) ../perl perl) && ./perl TEST </dev/tty
+  
+  clist:
+       echo $(c) | tr ' ' '\012' >.clist
+--- 349,355 ----
+  
+  test: perl
+       - cd t && chmod +x TEST */*.t
+!      - cd t && (rm -f perl; $(SLN) ../perl perl) && ./perl TEST
+  
+  clist:
+       echo $(c) | tr ' ' '\012' >.clist
+***************
+*** 373,376 ****
+      ln Makefile ../Makefile
+      ;;
+  esac
+! rm -f makefile
+--- 373,377 ----
+      ln Makefile ../Makefile
+      ;;
+  esac
+! #rm -f makefile  (AmigaDOS is case-independent)
+! 
+diff -rc perl-4.036-fsf/makedepend.SH perl-4.036-amiga/makedepend.SH
+*** perl-4.036-fsf/makedepend.SH       Mon Feb  8 20:36:27 1993
+--- perl-4.036-amiga/makedepend.SH     Mon Sep 27 22:06:33 1993
+***************
+*** 63,71 ****
+  $cat /dev/null >.deptmp
+  $rm -f *.c.c c/*.c.c
+  if test -f Makefile; then
+!     cp Makefile makefile
+  fi
+! mf=makefile
+  if test -f $mf; then
+      defrule=`<$mf sed -n             \
+       -e '/^\.c\.o:.*;/{'             \
+--- 63,71 ----
+  $cat /dev/null >.deptmp
+  $rm -f *.c.c c/*.c.c
+  if test -f Makefile; then
+!     cp Makefile Makefile.bak
+  fi
+! mf=Makefile
+  if test -f $mf; then
+      defrule=`<$mf sed -n             \
+       -e '/^\.c\.o:.*;/{'             \
+diff -rc perl-4.036-fsf/perl.h perl-4.036-amiga/perl.h
+*** perl-4.036-fsf/perl.h      Mon Feb  8 20:36:01 1993
+--- perl-4.036-amiga/perl.h    Mon Sep 27 22:06:19 1993
+***************
+*** 79,85 ****
+--- 79,87 ----
+   */
+  #define HAS_ALARM
+  #define HAS_CHOWN
++ #ifndef amigados
+  #define HAS_CHROOT
++ #endif
+  #define HAS_FORK
+  #define HAS_GETLOGIN
+  #define HAS_GETPPID
+***************
+*** 93,99 ****
+--- 95,103 ----
+   * password and group functions in general.  All Unix systems do.
+   */
+  #define HAS_GROUP
++ #ifndef amigados
+  #define HAS_PASSWD
++ #endif
+  
+  #endif /* !MSDOS */
+  
+diff -rc perl-4.036-fsf/x2p/Makefile.SH perl-4.036-amiga/x2p/Makefile.SH
+*** perl-4.036-fsf/x2p/Makefile.SH     Mon Feb  8 20:36:33 1993
+--- perl-4.036-amiga/x2p/Makefile.SH   Mon Sep 27 22:07:15 1993
+***************
+*** 157,160 ****
+      ln Makefile ../Makefile
+      ;;
+  esac
+! rm -f makefile
+--- 157,160 ----
+      ln Makefile ../Makefile
+      ;;
+  esac
+! #rm -f makefile
+
+
+
+
+
+
diff --git a/Bugs/delocalglob b/Bugs/delocalglob
new file mode 100755 (executable)
index 0000000..0a97695
--- /dev/null
@@ -0,0 +1,8 @@
+#!./perl
+$foo = GOOD;
+{ 
+    local(*foo) = \$bar;
+    $bar = BAR;
+    print $foo;
+}
+print $foo;
diff --git a/Bugs/f2p_prune b/Bugs/f2p_prune
new file mode 100644 (file)
index 0000000..519003d
--- /dev/null
@@ -0,0 +1,37 @@
+Article 18849 of comp.lang.perl:
+Path: netlabs!news.cerf.net!usc!howland.reston.ans.net!xlink.net!zib-berlin.de!zrz.TU-Berlin.DE!w204zrz!koen1830
+From: koen1830@w204zrz.zrz.tu-berlin.de (Andreas Koenig)
+Newsgroups: comp.lang.perl
+Subject: Bug in find2perl
+Date: 14 Feb 1994 09:43:16 GMT
+Organization: mal franz, mal anna
+Lines: 22
+Message-ID: <2jnh3k$hcv@brachio.zrz.TU-Berlin.DE>
+Reply-To: k@franz.ww.TU-Berlin.DE
+NNTP-Posting-Host: w204zrz.zrz.tu-berlin.de
+Cc: 
+
+Hi all,
+
+I've encountered a bug in find2perl when used with the -prune Option.
+As there have been some bugreports recently, *and* also because there
+has to be fixed an incompatibility with perl5, I don't try to offer a
+fix, sorry. The bug comes and goes like this (verified for SUN and
+NeXT):
+
+%/usr/bin/find foo -print
+foo
+foo/bar
+foo/bar/baz
+%/usr/bin/find foo -prune -print
+foo
+%perl /usr/local/bin/find2perl foo -prune -print | perl
+foo
+foo/bar
+%perl5a5 /usr/local/bin/find2perl foo -prune -print | perl5a5
+Final $ should be \$ or $name at /usr/local/bin/find2perl line 553, at end of string
+syntax error at /usr/local/bin/find2perl line 553, near ""^$tmp$""
+Execution of /usr/local/bin/find2perl aborted due to compilation errors.
+
+
+
diff --git a/Bugs/mislex b/Bugs/mislex
deleted file mode 100644 (file)
index 07d972b..0000000
+++ /dev/null
@@ -1 +0,0 @@
-print( STDOUT "hello\n" )
diff --git a/Bugs/pagdir b/Bugs/pagdir
deleted file mode 100755 (executable)
index 7cc76f2..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-Article 433 of comp.os.386bsd.apps:
-Path: netlabs!news.cerf.net!usc!howland.reston.ans.net!spool.mu.edu!bloom-beacon.mit.edu!ai-lab!life.ai.mit.edu!mycroft
-From: mycroft@trinity.gnu.ai.mit.edu (Charles Hannum)
-Newsgroups: comp.os.386bsd.apps
-Subject: Re: Perl-4.036?
-Date: 06 Sep 1993 19:01:10 GMT
-Organization: MIT Artificial Intelligence Lab
-Lines: 9
-Message-ID: <MYCROFT.93Sep6150110@trinity.gnu.ai.mit.edu>
-References: <26fptu$1q1@terminator.rs.itd.umich.edu> <26fve4$ivf@homer.cs.mcgill.ca>
-NNTP-Posting-Host: trinity.gnu.ai.mit.edu
-In-reply-to: storm@cs.mcgill.ca's message of 6 Sep 1993 18:27:16 GMT
-
-
-   Perl 4.036 comipled without a single hitch under NetBSD 0.9 last
-   week.  It failed the db test, but I suspect that is due to the new
-   db stuff under NetBSD and the like...
-
-Yes.  The perl test seems to expect the database to be put in
-`foo.pag' and `foo.dir', which isn't the case any more.  I suspect
-lwall will fix this soon.
-
-
-
diff --git a/Bugs/shiftref b/Bugs/shiftref
deleted file mode 100755 (executable)
index e4ab0c5..0000000
+++ /dev/null
@@ -1 +0,0 @@
-shift->[0]
diff --git a/Changes b/Changes
index 4dbcd46..70e9e2b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -60,6 +60,32 @@ New things
 
     New functions include: abs(), chr(), uc(), ucfirst(), lc(), lcfirst()
 
+    require with a bare word now does an immediate require at compile time.
+    So "require POSIX" is equivalent to "BEGIN { require 'POSIX.pm' }".
+
+    require with a number checks to see that the version of Perl that is
+    currently running is at least that number.
+
+    Dynamic loading of external modules is now supported.
+
+    There is a new quote form qw//, which is equivalent to split(' ', q//).
+
+    Assignment of a reference to a glob value now just replaces the
+    single element of the glob corresponding to the reference type:
+       *foo = \$bar, *foo = \&bletch;
+
+    Filehandle methods are now supported:
+       output_autoflush STDOUT 1;
+
+    There is now an "English" module that provides human readable translations
+    for cryptic variable names.
+
+    Autoload stubs can now call the replacement subroutine with goto &realsub.
+
+    Subroutines can be defined lazily in any package by declaring an AUTOLOAD
+    routine, which will be called if a non-existent subroutine is called in
+    that package.
+
 Incompatibilities
 -----------------
     @ now always interpolates an array in double-quotish strings.  Some programs
@@ -99,4 +125,9 @@ Incompatibilities
     Symbols starting with _ are no longer forced into package main, except
     for $_ itself (and @_, etc.).
 
-    Double-quoted strings may no longer end with an unescaped $.
+    Double-quoted strings may no longer end with an unescaped $ or @.
+
+    Negative array subscripts now count from the end of the array.
+
+    The comma operator in a scalar context is now guaranteed to give a
+    scalar context to its arguments.
index 3040534..5f29958 100644 (file)
@@ -8,12 +8,12 @@ typedef DBM* NDBM_File;
 #define nextkey(db,key) dbm_nextkey(db)
 
 static int
-XS_NDBM_File_dbm_new(ix, sp, items)
+XS_NDBM_File_dbm_new(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 4 || items > 4) {
+    if (items != 4) {
        croak("Usage: NDBM_File::new(dbtype, filename, flags, mode)");
     }
     {
@@ -24,40 +24,40 @@ register int items;
        NDBM_File       RETVAL;
 
        RETVAL = dbm_new(dbtype, filename, flags, mode);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setptrobj(ST(0), RETVAL, "NDBM_File");
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_NDBM_File_dbm_DESTROY(ix, sp, items)
+XS_NDBM_File_dbm_DESTROY(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 1 || items > 1) {
+    if (items != 1) {
        croak("Usage: NDBM_File::DESTROY(db)");
     }
     {
        NDBM_File       db;
 
-       if (sv_isa(ST(1), "NDBM_File"))
-           db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+       if (SvROK(ST(1)))
+           db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           croak("db is not of type NDBM_File");
+           croak("db is not a reference");
        dbm_close(db);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_NDBM_File_dbm_fetch(ix, sp, items)
+XS_NDBM_File_dbm_fetch(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 2 || items > 2) {
+    if (items != 2) {
        croak("Usage: NDBM_File::fetch(db, key)");
     }
     {
@@ -66,23 +66,23 @@ register int items;
        datum   RETVAL;
 
        if (sv_isa(ST(1), "NDBM_File"))
-           db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type NDBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
        RETVAL = dbm_fetch(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_NDBM_File_dbm_store(ix, sp, items)
+XS_NDBM_File_dbm_store(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
     if (items < 3 || items > 4) {
@@ -96,7 +96,7 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "NDBM_File"))
-           db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type NDBM_File");
 
@@ -111,19 +111,19 @@ register int items;
        }
 
        RETVAL = dbm_store(db, key, value, flags);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_NDBM_File_dbm_delete(ix, sp, items)
+XS_NDBM_File_dbm_delete(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 2 || items > 2) {
+    if (items != 2) {
        croak("Usage: NDBM_File::delete(db, key)");
     }
     {
@@ -132,26 +132,26 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "NDBM_File"))
-           db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type NDBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
        RETVAL = dbm_delete(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_NDBM_File_dbm_firstkey(ix, sp, items)
+XS_NDBM_File_dbm_firstkey(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 1 || items > 1) {
+    if (items != 1) {
        croak("Usage: NDBM_File::firstkey(db)");
     }
     {
@@ -159,24 +159,24 @@ register int items;
        datum   RETVAL;
 
        if (sv_isa(ST(1), "NDBM_File"))
-           db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type NDBM_File");
 
        RETVAL = dbm_firstkey(db);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_NDBM_File_nextkey(ix, sp, items)
+XS_NDBM_File_nextkey(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 2 || items > 2) {
+    if (items != 2) {
        croak("Usage: NDBM_File::nextkey(db, key)");
     }
     {
@@ -185,26 +185,26 @@ register int items;
        datum   RETVAL;
 
        if (sv_isa(ST(1), "NDBM_File"))
-           db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type NDBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
        RETVAL = nextkey(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_NDBM_File_dbm_error(ix, sp, items)
+XS_NDBM_File_dbm_error(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 1 || items > 1) {
+    if (items != 1) {
        croak("Usage: NDBM_File::error(db)");
     }
     {
@@ -212,24 +212,24 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "NDBM_File"))
-           db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type NDBM_File");
 
        RETVAL = dbm_error(db);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_NDBM_File_dbm_clearerr(ix, sp, items)
+XS_NDBM_File_dbm_clearerr(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 1 || items > 1) {
+    if (items != 1) {
        croak("Usage: NDBM_File::clearerr(db)");
     }
     {
@@ -237,20 +237,20 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "NDBM_File"))
-           db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (NDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type NDBM_File");
 
        RETVAL = dbm_clearerr(db);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
-    return sp;
+    return ax;
 }
 
-int init_NDBM_File(ix,sp,items)
+int boot_NDBM_File(ix,ax,items)
 int ix;
-int sp;
+int ax;
 int items;
 {
     char* file = __FILE__;
index 7c5f780..27e5dee 100644 (file)
@@ -22,12 +22,12 @@ static int dbmrefcnt;
 #define DBM_REPLACE 0
 
 static int
-XS_ODBM_File_odbm_new(ix, sp, items)
+XS_ODBM_File_odbm_new(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 4 || items > 4) {
+    if (items != 4) {
        croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)");
     }
     {
@@ -57,38 +57,38 @@ register int items;
            sv_setptrobj(ST(0), RETVAL, "ODBM_File");
        }
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_ODBM_File_DESTROY(ix, sp, items)
+XS_ODBM_File_DESTROY(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 1 || items > 1) {
+    if (items != 1) {
        croak("Usage: ODBM_File::DESTROY(db)");
     }
     {
        ODBM_File       db;
 
-       if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+       if (SvROK(ST(1)))
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           croak("db is not of type ODBM_File");
+           croak("db is not a reference");
        dbmrefcnt--;
        dbmclose();
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_ODBM_File_odbm_fetch(ix, sp, items)
+XS_ODBM_File_odbm_fetch(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 2 || items > 2) {
+    if (items != 2) {
        croak("Usage: ODBM_File::fetch(db, key)");
     }
     {
@@ -97,23 +97,23 @@ register int items;
        datum   RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type ODBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
        RETVAL = odbm_fetch(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_ODBM_File_odbm_store(ix, sp, items)
+XS_ODBM_File_odbm_store(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
     if (items < 3 || items > 4) {
@@ -127,7 +127,7 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type ODBM_File");
 
@@ -142,19 +142,19 @@ register int items;
        }
 
        RETVAL = odbm_store(db, key, value, flags);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_ODBM_File_odbm_delete(ix, sp, items)
+XS_ODBM_File_odbm_delete(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 2 || items > 2) {
+    if (items != 2) {
        croak("Usage: ODBM_File::delete(db, key)");
     }
     {
@@ -163,26 +163,26 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type ODBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
        RETVAL = odbm_delete(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_ODBM_File_odbm_firstkey(ix, sp, items)
+XS_ODBM_File_odbm_firstkey(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 1 || items > 1) {
+    if (items != 1) {
        croak("Usage: ODBM_File::firstkey(db)");
     }
     {
@@ -190,24 +190,24 @@ register int items;
        datum   RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type ODBM_File");
 
        RETVAL = odbm_firstkey(db);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
     }
-    return sp;
+    return ax;
 }
 
 static int
-XS_ODBM_File_odbm_nextkey(ix, sp, items)
+XS_ODBM_File_odbm_nextkey(ix, ax, items)
 register int ix;
-register int sp;
+register int ax;
 register int items;
 {
-    if (items < 2 || items > 2) {
+    if (items != 2) {
        croak("Usage: ODBM_File::nextkey(db, key)");
     }
     {
@@ -216,22 +216,22 @@ register int items;
        datum   RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
            croak("db is not of type ODBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
        RETVAL = odbm_nextkey(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
     }
-    return sp;
+    return ax;
 }
 
-int init_ODBM_File(ix,sp,items)
+int boot_ODBM_File(ix,ax,items)
 int ix;
-int sp;
+int ax;
 int items;
 {
     char* file = __FILE__;
diff --git a/POSIX.c b/POSIX.c
new file mode 100644 (file)
index 0000000..cf3ada3
--- /dev/null
+++ b/POSIX.c
@@ -0,0 +1,856 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <sys/utsname.h>
+
+#define HAS_UNAME
+
+#ifndef HAS_GETPGRP
+#define getpgrp(a,b) not_here("getpgrp")
+#endif
+#ifndef HAS_NICE
+#define nice(a) not_here("nice")
+#endif
+#ifndef HAS_READLINK
+#define readlink(a,b,c) not_here("readlink")
+#endif
+#ifndef HAS_SETPGID
+#define setpgid(a,b) not_here("setpgid")
+#endif
+#ifndef HAS_SETPGRP
+#define setpgrp(a,b) not_here("setpgrp")
+#endif
+#ifndef HAS_SETSID
+#define setsid() not_here("setsid")
+#endif
+#ifndef HAS_SYMLINK
+#define symlink(a,b) not_here("symlink")
+#endif
+#ifndef HAS_TCGETPGRP
+#define tcgetpgrp(a) not_here("tcgetpgrp")
+#endif
+#ifndef HAS_TCSETPGRP
+#define tcsetpgrp(a,b) not_here("tcsetpgrp")
+#endif
+#ifndef HAS_TIMES
+#define times(a) not_here("times")
+#endif
+#ifndef HAS_UNAME
+#define uname(a) not_here("uname")
+#endif
+#ifndef HAS_WAITPID
+#define waitpid(a,b,c) not_here("waitpid")
+#endif
+
+static int
+not_here(s)
+char *s;
+{
+    croak("POSIX::%s not implemented on this architecture", s);
+    return -1;
+}
+
+static int
+XS_POSIX__exit(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 1) {
+       croak("Usage: POSIX::_exit(status)");
+    }
+    {
+       int     status = (int)SvIV(ST(1));
+
+       _exit(status);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_chdir(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 1) {
+       croak("Usage: POSIX::chdir(path)");
+    }
+    {
+       char *  path = SvPV(ST(1),na);
+       int     RETVAL;
+
+       RETVAL = chdir(path);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_chmod(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 2) {
+       croak("Usage: POSIX::chmod(path, mode)");
+    }
+    {
+       char *  path = SvPV(ST(1),na);
+       mode_t  mode = (int)SvIV(ST(2));
+       int     RETVAL;
+
+       RETVAL = chmod(path, mode);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_close(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 1) {
+       croak("Usage: POSIX::close(fd)");
+    }
+    {
+       int     fd = (int)SvIV(ST(1));
+       int     RETVAL;
+
+       RETVAL = close(fd);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_dup(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 1) {
+       croak("Usage: POSIX::dup(fd)");
+    }
+    {
+       int     fd = (int)SvIV(ST(1));
+       int     RETVAL;
+
+       RETVAL = dup(fd);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_dup2(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 2) {
+       croak("Usage: POSIX::dup2(fd1, fd2)");
+    }
+    {
+       int     fd1 = (int)SvIV(ST(1));
+       int     fd2 = (int)SvIV(ST(2));
+       int     RETVAL;
+
+       RETVAL = dup2(fd1, fd2);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_fdopen(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 2) {
+       croak("Usage: POSIX::fdopen(fd, type)");
+    }
+    {
+       int     fd = (int)SvIV(ST(1));
+       char *  type = SvPV(ST(2),na);
+       FILE *  RETVAL;
+
+       RETVAL = fdopen(fd, type);
+       ST(0) = sv_newmortal();
+       sv_setnv(ST(0), (double)(unsigned long)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_fstat(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 2) {
+       croak("Usage: POSIX::fstat(fd, buf)");
+    }
+    {
+       int     fd = (int)SvIV(ST(1));
+       struct stat * buf = (struct stat*)sv_grow(ST(2),sizeof(struct stat));
+       int     RETVAL;
+
+       RETVAL = fstat(fd, buf);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+       SvCUR(ST(2)) = sizeof(struct stat);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_getpgrp(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 1) {
+       croak("Usage: POSIX::getpgrp(pid)");
+    }
+    {
+       int     pid = (int)SvIV(ST(1));
+       int     RETVAL;
+
+       RETVAL = getpgrp(pid);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_link(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::link()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = link();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_lseek(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::lseek()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = lseek();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_lstat(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::lstat()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = lstat();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_mkdir(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::mkdir()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = mkdir();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_nice(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 1) {
+       croak("Usage: POSIX::nice(incr)");
+    }
+    {
+       int     incr = (int)SvIV(ST(1));
+       int     RETVAL;
+
+       RETVAL = nice(incr);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_open(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::open()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = open();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_pipe(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::pipe()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = pipe();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_read(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::read()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = read();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_readlink(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 3) {
+       croak("Usage: POSIX::readlink(path, buf, bufsiz)");
+    }
+    {
+       char *  path = SvPV(ST(1),na);
+       char * buf = sv_grow(ST(2), SvIV(ST(3)));
+       int     bufsiz = (int)SvIV(ST(3));
+       int     RETVAL;
+
+       RETVAL = readlink(path, buf, bufsiz);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_rename(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::rename()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = rename();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_rmdir(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::rmdir()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = rmdir();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_setgid(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::setgid()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = setgid();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_setpgid(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 2) {
+       croak("Usage: POSIX::setpgid(pid, pgid)");
+    }
+    {
+       pid_t   pid = (int)SvIV(ST(1));
+       pid_t   pgid = (int)SvIV(ST(2));
+       int     RETVAL;
+
+       RETVAL = setpgid(pid, pgid);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_setpgrp(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 2) {
+       croak("Usage: POSIX::setpgrp(pid, pgrp)");
+    }
+    {
+       int     pid = (int)SvIV(ST(1));
+       int     pgrp = (int)SvIV(ST(2));
+       int     RETVAL;
+
+       RETVAL = setpgrp(pid, pgrp);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_setsid(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::setsid()");
+    }
+    {
+       pid_t   RETVAL;
+
+       RETVAL = setsid();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_setuid(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::setuid()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = setuid();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_stat(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::stat()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = stat();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_symlink(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::symlink()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = symlink();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_system(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::system()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = system();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_tcgetpgrp(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 1) {
+       croak("Usage: POSIX::tcgetpgrp(fd)");
+    }
+    {
+       int     fd = (int)SvIV(ST(1));
+       pid_t   RETVAL;
+
+       RETVAL = tcgetpgrp(fd);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_tcsetpgrp(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 2) {
+       croak("Usage: POSIX::tcsetpgrp(fd, pgrp_id)");
+    }
+    {
+       int     fd = (int)SvIV(ST(1));
+       pid_t   pgrp_id = (int)SvIV(ST(2));
+       int     RETVAL;
+
+       RETVAL = tcsetpgrp(fd, pgrp_id);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_times(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 1) {
+       croak("Usage: POSIX::times(tms)");
+    }
+    {
+       struct tms * tms = (struct tms*)sv_grow(ST(1), sizeof(struct tms));
+       int     RETVAL;
+
+       RETVAL = times(tms);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+       SvCUR(ST(1)) = sizeof(struct tms);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_umask(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::umask()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = umask();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_uname(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::uname()");
+    }
+    {
+       int     RETVAL;
+       dSP;
+       struct utsname utsname;
+       sp--;
+       if (uname(&utsname) >= 0) {
+           EXTEND(sp, 5);
+           PUSHs(sv_2mortal(newSVpv(utsname.sysname, 0)));
+           PUSHs(sv_2mortal(newSVpv(utsname.nodename, 0)));
+           PUSHs(sv_2mortal(newSVpv(utsname.release, 0)));
+           PUSHs(sv_2mortal(newSVpv(utsname.version, 0)));
+           PUSHs(sv_2mortal(newSVpv(utsname.machine, 0)));
+       }
+       return sp - stack_base;
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_unlink(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::unlink()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = unlink();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_utime(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::utime()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = utime();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_wait(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::wait()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = wait();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_waitpid(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 3) {
+       croak("Usage: POSIX::waitpid(pid, statusp, options)");
+    }
+    {
+       int     pid = (int)SvIV(ST(1));
+       int     statusp = (int)SvIV(ST(2));
+       int     options = (int)SvIV(ST(3));
+       int     RETVAL;
+
+       RETVAL = waitpid(pid, &statusp, options);
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+       sv_setiv(ST(2), (I32)statusp);
+    }
+    return ax;
+}
+
+static int
+XS_POSIX_write(ix, ax, items)
+register int ix;
+register int ax;
+register int items;
+{
+    if (items != 0) {
+       croak("Usage: POSIX::write()");
+    }
+    {
+       int     RETVAL;
+
+       RETVAL = write();
+       ST(0) = sv_newmortal();
+       sv_setiv(ST(0), (I32)RETVAL);
+    }
+    return ax;
+}
+
+int boot_POSIX(ix,ax,items)
+int ix;
+int ax;
+int items;
+{
+    char* file = __FILE__;
+
+    newXSUB("POSIX::_exit", 0, XS_POSIX__exit, file);
+    newXSUB("POSIX::chdir", 0, XS_POSIX_chdir, file);
+    newXSUB("POSIX::chmod", 0, XS_POSIX_chmod, file);
+    newXSUB("POSIX::close", 0, XS_POSIX_close, file);
+    newXSUB("POSIX::dup", 0, XS_POSIX_dup, file);
+    newXSUB("POSIX::dup2", 0, XS_POSIX_dup2, file);
+    newXSUB("POSIX::fdopen", 0, XS_POSIX_fdopen, file);
+    newXSUB("POSIX::fstat", 0, XS_POSIX_fstat, file);
+    newXSUB("POSIX::getpgrp", 0, XS_POSIX_getpgrp, file);
+    newXSUB("POSIX::link", 0, XS_POSIX_link, file);
+    newXSUB("POSIX::lseek", 0, XS_POSIX_lseek, file);
+    newXSUB("POSIX::lstat", 0, XS_POSIX_lstat, file);
+    newXSUB("POSIX::mkdir", 0, XS_POSIX_mkdir, file);
+    newXSUB("POSIX::nice", 0, XS_POSIX_nice, file);
+    newXSUB("POSIX::open", 0, XS_POSIX_open, file);
+    newXSUB("POSIX::pipe", 0, XS_POSIX_pipe, file);
+    newXSUB("POSIX::read", 0, XS_POSIX_read, file);
+    newXSUB("POSIX::readlink", 0, XS_POSIX_readlink, file);
+    newXSUB("POSIX::rename", 0, XS_POSIX_rename, file);
+    newXSUB("POSIX::rmdir", 0, XS_POSIX_rmdir, file);
+    newXSUB("POSIX::setgid", 0, XS_POSIX_setgid, file);
+    newXSUB("POSIX::setpgid", 0, XS_POSIX_setpgid, file);
+    newXSUB("POSIX::setpgrp", 0, XS_POSIX_setpgrp, file);
+    newXSUB("POSIX::setsid", 0, XS_POSIX_setsid, file);
+    newXSUB("POSIX::setuid", 0, XS_POSIX_setuid, file);
+    newXSUB("POSIX::stat", 0, XS_POSIX_stat, file);
+    newXSUB("POSIX::symlink", 0, XS_POSIX_symlink, file);
+    newXSUB("POSIX::system", 0, XS_POSIX_system, file);
+    newXSUB("POSIX::tcgetpgrp", 0, XS_POSIX_tcgetpgrp, file);
+    newXSUB("POSIX::tcsetpgrp", 0, XS_POSIX_tcsetpgrp, file);
+    newXSUB("POSIX::times", 0, XS_POSIX_times, file);
+    newXSUB("POSIX::umask", 0, XS_POSIX_umask, file);
+    newXSUB("POSIX::uname", 0, XS_POSIX_uname, file);
+    newXSUB("POSIX::unlink", 0, XS_POSIX_unlink, file);
+    newXSUB("POSIX::utime", 0, XS_POSIX_utime, file);
+    newXSUB("POSIX::wait", 0, XS_POSIX_wait, file);
+    newXSUB("POSIX::waitpid", 0, XS_POSIX_waitpid, file);
+    newXSUB("POSIX::write", 0, XS_POSIX_write, file);
+}
diff --git a/Quick b/Quick
new file mode 100644 (file)
index 0000000..13d6ae0
--- /dev/null
+++ b/Quick
@@ -0,0 +1,170 @@
+#!/usr/local/bin/perl5
+#
+# This document is in the public domain.
+#
+# The purpose is to document by example some of the new Perl5 features.
+# It also functions as a mini test suite; you can extracted the
+# expected output using:
+#     perl -ne 'm/.*prints ``(.*)..$/ && print $1,"\n";'
+# There are a couple of places that print out internal address so it's
+# not perfect yet, those should be fixed.
+#
+# Thanks to the following for their input:
+#     Johan.Vromans@NL.net
+#     Daniel Faken <absinthe@viva.chem.washington.edu>
+#     Tom Christiansen <tchrist@wraeththu.cs.colorado.edu>
+#     Dean Roehrich <roehrich@ferrari.cray.com>
+#     Larry Wall <lwall@netlabs.com>
+#
+# TODO when I get perl5a6 to play with
+#      *foo = \&func;                  # replaces only function (etc)
+#      AUTOLOAD { ...; }               # called if method not found
+#      goto &func;                     # goto's a function
+#      require FOOBAR;                 # loads FOOBAR.pm
+#      @ISA
+#
+#      import()/@EXPORT/etc
+
+#   my
+       # static scoping
+       sub samp1 { print $z,"\n"; }
+       sub samp2 { my($z) = "world"; &samp1; }
+       $z = "hello"; &samp2;           # prints ``hello''
+
+#   package;
+       # for catching non-local variable references
+       sub samp3 {
+           my $x = shift;              # local() would work also
+           package;                    # empty package
+           $main::count += $x;         # this is ok.
+           # $y = 1;                   # compile time error
+       }
+
+#   =>
+       # works like comma (,); use for key/value pairs
+        # sometimes used to disambiguate the final expression in a block
+       # might someday supply warnings if you get out of sync
+       %foo = ( abc => foo );
+       print $foo{abc},"\n";           # prints ``foo''
+
+#   ::
+       # works like tick (') (use of ' is deprecated in perl5)
+        print $main::foo{abc},"\n";    # prints ``foo''
+
+#   bless ref;
+       # Bless takes a reference and returns an "object"
+       $oref = bless \$scalar;
+
+#   ->
+       # dereferences an "object"
+       $x = { def => bar };            # $x is ref to anonymous hash
+       print $x->{def},"\n";           # prints ``bar''
+
+       # method derefs must be bless'ed
+       {
+           package sample;
+           sub samp4 { my($this) = shift; print $this->{def},"\n"; }
+           sub samp5 { print "samp5: @_\n"; }
+           $main::y = bless $main::x;  # $x is ref, $y is "object"
+       }
+       $y->samp4();                    # prints ``bar''
+
+       # indirect object calls
+       samp5 $y arglist;               # prints ``samp5: sample=HASH(0xa85e0) arglist''
+
+       # static method calls (often used for constructors, see below)
+       samp5 sample arglist;           # prints ``samp5: sample arglist''
+
+#   function calls without &
+       sub samp6 { print "look ma\n"; }
+       samp6;                          # prints ``look ma''
+
+#   ref
+       # returns "object" type
+       {
+           package OBJ1;
+           $x = bless \$y;             # returns "object" $x in "class" OBJ1
+           print ref $x,"\n";          # prints ``OBJ1''
+       }
+
+       # and non-references return undef.
+       $z = 1;
+       print "non-ref\n" if !defined(ref $z);          # prints ``non-ref''
+
+       # ref's to "builtins" return type
+       print ref \$ascalar,"\n";               # prints ``SCALAR''
+       print ref \@array,"\n";                 # prints ``ARRAY''
+       print ref \%hash,"\n";                  # prints ``HASH''
+       sub func { print shift,"\n"; }
+       print ref \&func,"\n";                  # prints ``CODE''
+       print ref \\$scalar,"\n";               # prints ``REF''
+
+#   tie
+       # bind a variable to a package with magic functions:
+        #     new, fetch, store, delete, firstkey, nextkey (XXX: others???)
+       # Usage: tie variable, PackageName, ARGLIST
+       {
+           package TIEPACK;
+           sub new { print "NEW: @_\n"; my($class, $x) = @_; bless \$x }
+           sub fetch { print "fetch @_\n"; my($this) = @_; ${$this} }
+           sub store { print "store @_\n"; my($this, $x) = @_; ${$this} = $x }
+           sub DESTROY { print "DESTROY @_\n" }
+       }
+       tie $h, TIEPACK, "black_tie";   # prints ``NEW: TIEPACK black_tie''
+       print $h, "\n";                 # prints ``fetch TIEPACK=SCALAR(0x882a0)''
+                                       # prints ``black_tie''
+       $h = 'bar';                     # prints ``store TIEPACK=SCALAR(0x882a0) bar''
+       untie $h;                       # DESTROY (XXX: broken in perl5a5???)
+
+#   References and Anonymous data-structures
+       $sref = \$scalar;               # $$sref is scalar
+       $aref = \@array;                # @$aref is array
+       $href = \%hash;                 # %$href is hash table
+       $fref = \&func;                 # &$fref is function
+       $refref = \$fref;               # ref to ref to function
+       &$$refref("call the function"); # prints ``call the function''
+
+       %hash = ( abc => foo );         # hash (just like perl4)
+       print $hash{abc},"\n";          # prints ``foo''
+       $ref = { abc => bar };          # reference to anon hash
+       print $ref->{abc},"\n";         # prints ``bar''
+
+       @ary = ( 0, 1, 2 );             # array (just like perl4)
+       print $ary[1],"\n";             # prints ``1''
+       $ref = [ 3, 4, 5 ];             # reference to anon array
+       print $ref->[1],"\n";           # prints ``4''
+
+#   Nested data-structures
+       @foo = ( 0, { name => foobar }, 2, 3 );         # $#foo == 3
+       $aref = [ 0, { name => foobar }, 2, 3 ];        # ref to anon array
+       $href = {                                       # ref to hash of arrays
+           John => [ Mary, Pat, Blanch ],
+           Paul => [ Sally, Jill, Jane ],
+           Mark => [ Ann, Bob, Dawn ],
+       };
+       print $href->{Paul}->[0], "\n";                 # prints ``Sally''
+       print $href->{Paul}[0],"\n";                    # shorthand version, prints ``Sally''
+
+#   Multiple Inheritence (get rich quick :-)
+       {
+           package OBJ2; sub abc { print "abc\n"; }
+           package OBJ3; sub def { print "def\n"; }
+           package OBJ4; @ISA = ("OBJ2", "OBJ3");
+           $x = bless { foo => bar };
+           $x->abc;                                    # prints ``abc''
+           $x->def;                                    # prints ``def''
+       }
+
+#   Packages, Classes, Objects, Methods, Constructors, Destructors, etc.
+       # XXX: I'll add more explinations/samples about the above here
+       {
+           package OBJ5;
+           sub new { print "NEW: @_\n"; my($x) = "empty"; bless \$x }
+           sub DESTROY { print "DESTROY\n" }
+           sub output { my($this) = shift; print "value = $$this\n"; }
+       }
+       # Constructors are often written as static method calls:
+       $x = new OBJ5;          # prints ``NEW: OBJ5''
+       $x->output;             # prints ``value = empty''
+       # The destructor is responsible for calling any base class destructors.
+       undef $x;
index d6e08c4..459cfa2 100644 (file)
@@ -24,7 +24,7 @@ register int items;
        SDBM_File       RETVAL;
 
        RETVAL = sdbm_new(dbtype, filename, flags, mode);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setptrobj(ST(0), RETVAL, "SDBM_File");
     }
     return sp;
@@ -42,10 +42,10 @@ register int items;
     {
        SDBM_File       db;
 
-       if (sv_isa(ST(1), "SDBM_File"))
+       if (SvROK(ST(1)))
            db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           croak("db is not of type SDBM_File");
+           croak("db is not a reference");
        sdbm_close(db);
     }
     return sp;
@@ -73,7 +73,7 @@ register int items;
        key.dptr = SvPV(ST(2), key.dsize);;
 
        RETVAL = sdbm_fetch(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
     }
     return sp;
@@ -111,7 +111,7 @@ register int items;
        }
 
        RETVAL = sdbm_store(db, key, value, flags);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
     return sp;
@@ -139,7 +139,7 @@ register int items;
        key.dptr = SvPV(ST(2), key.dsize);;
 
        RETVAL = sdbm_delete(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
     return sp;
@@ -164,7 +164,7 @@ register int items;
            croak("db is not of type SDBM_File");
 
        RETVAL = sdbm_firstkey(db);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
     }
     return sp;
@@ -192,7 +192,7 @@ register int items;
        key.dptr = SvPV(ST(2), key.dsize);;
 
        RETVAL = nextkey(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
     }
     return sp;
@@ -217,7 +217,7 @@ register int items;
            croak("db is not of type SDBM_File");
 
        RETVAL = sdbm_error(db);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
     return sp;
@@ -242,13 +242,13 @@ register int items;
            croak("db is not of type SDBM_File");
 
        RETVAL = sdbm_clearerr(db);
-       ST(0) = sv_mortalcopy(&sv_undef);
+       ST(0) = sv_newmortal();
        sv_setiv(ST(0), (I32)RETVAL);
     }
     return sp;
 }
 
-int init_SDBM_File(ix,sp,items)
+int boot_SDBM_File(ix,sp,items)
 int ix;
 int sp;
 int items;
diff --git a/TCL b/TCL
deleted file mode 100644 (file)
index 5409bbf..0000000
--- a/TCL
+++ /dev/null
@@ -1,169 +0,0 @@
-Article 1475 of comp.lang.tcl:
-Path: netlabs!news!usc!cs.utexas.edu!sun-barr!ames!agate!sprite.Berkeley.EDU!ouster
-From: ouster@sprite.Berkeley.EDU (John Ousterhout)
-Newsgroups: comp.lang.tcl
-Subject: Planning for Tcl 7.0
-Message-ID: <1avu22INN5ao@agate.berkeley.edu>
-Date: 8 Oct 92 00:06:26 GMT
-Organization: U.C. Berkeley Sprite Project
-Lines: 156
-NNTP-Posting-Host: tyranny.berkeley.edu
-
-
-For the last year I've made only small changes to Tcl while focussing
-on the canvas and text widgets for Tk.  I'm now making plans to catch
-up on a bunch of much-needed bug fixes and enhancements to Tcl.  Some
-of the changes I'm considering are not backwards-compatible.  The
-purpose of this message is to let know know what changes I'm considering
-for Tcl 7.0 and to solicit feedback.  I'm particularly interested in
-comments on the changes that are incompatible:  I'll probably drop
-the changes for which I get lots of negative feedback and not much
-positive feedback.  If there are other changes that you think are
-important but aren't contained on this list, let me know and I may add
-them.
-
-Incompatible changes:
----------------------
-
-The changes listed below are likely to require changes to existing
-scripts and/or C code.  Each change includes an explanation of why the
-change might be useful.  I'd like to know whether or not you think the change
-is useful enough to justify the incompatibility.
-
-1. Eliminate the "|" option in the "open" command.  Instead, add a
-"popen" command that does the same thing. Rationale: in the current
-implementation you can't open a file whose name begins with "|".
-Also, I think the "popen" command would be more logical.
-
-2. Eliminate the Tcl_WaitPids procedure and use the waitpid POSIX call
-instead.  Also change the wait code to periodically poll for dead
-child processes so that zombie processes don't get left around forever.
-Rationale: the current code tends to leave zombies around in some
-situations.  Switching to waitpid should solve this problem in a
-relatively portable fashion.  The only incompatibility will be for
-C procedures that call Tcl_WaitPids;  they'll have to switch to call
-waitpid instead.  I'll provide a compatibility version of waitpid for
-use on systems that don't have it yet.
-
-3. Clean up backslash processing in several ways:
-    - Change backslash-newline to eat up all the whitespace following the
-      newline and replace the sequence with a single whitespace character.
-      Right now it only eats up the newline character and replaces it
-      with an empty string.  Rationale:  this would be more consistent
-      with other programs that process backslash-newline sequences.
-    - Eliminate the sequences \Mxx, \Cxxx, and \e.
-      Rationale: these sequences are left around from ancient times.
-      They're not particular compatible with any other program.  I
-      should have removed them in Tcl 6.0 but didn't.  They did get
-      removed from the documentation, however, so no-one should be
-      using them (?).
-    - Change \x (where x is not one of the characters that gets special
-      backslash treatment) to expand to x, not \x.
-      Rationale: the current behavior is inconsistent with all other
-      programs I know of that handle backslashes, and I think it's
-      confusing.
-    - Change "format" so it doesn't do an additional layer of backslash
-      processing on its format string.
-      Rationale:  I don't know why it currently behaves as it does, and
-      I think it's confusing.
-
-4. Change "regsub" so that when no match occurs it sets the result
-variable to the original string, rather than leaving it unmodified.
-Rationale:  the current behavior results in extra tests of the regsub
-result that could sometimes be avoided with the proposed new behavior.
-I doubt that there's much code that will break with the change (this
-would have to be code that depends on the result variable *not* being
-modified).
-
-5. Change the name "UNIX" in the "errorCode" variable to "POSIX".
-Rationale:  I suspect that I'm eventually going to get a call from the
-USL lawyers on this one if I don't change it.  Better to change it now
-in an orderly fashion so I don't have change it hastily in the future.
-
-6. Change glob to return only the names of existing files.
-Rationale:  at present "glob */foo" expands * and generates a result
-without checking to see if each directory has a "foo" file in it.  This
-makes the current behavior incompatible with csh, for example.  One
-question is whether constructs like "glob {a,b}.c" should also check for
-the existence of each of the files.  At present they don't (i.e. a.c and
-b.c will be returned even if they don't exist), but neither does csh.  My
-inclination is to make the behavior match csh (names containing *?[] are
-checked for existence, others aren't).  I'd be interested to hear
-opinions on this one:  check all names for existence, check only names
-including *?[] (for csh compatibility), or keep it as it is?
-
-7. Change "gets" so it returns 1 for success and 0 for failure.  At present
-it returns the line length for success and -1 for failure.
-Rationale: this would allow slightly simple Tcl scripts:  you could just
-say
-    while [gets $f line] {...}
-instead of
-    while {[gets $f line] >= 0} {...}
-I'm not really convinced that this one is important enough to justify the
-incompatibility, so it won't take much negative feedback to kill it.
-
-Other changes:
---------------
-
-The changes listed below shouldn't introduce substantial compatibility
-problems.  Of course, any change can potentially cause scripts to stop
-working (e.g. almost any change will break the test suite), but very
-few if any people should be affected by these changes.
-
-8. Implement Tcl_CreateExternVar() procedure along lines proposed by
-Andreas Stolcke to tie a C variable to a Tcl variable with automatic
-updates between them.
-
-9. Changes to exec:
-    - Allow redirection to an existing file descriptor in "exec",
-      with a mechanism like >&1 or >& stdout.
-    - Allow file names immediately after ">" and "<" without
-      intervening spaces.
-
-10. Changes related to files:
-    - Fix Scott Bolte bug (closing stdin and stdout).
-    - Move TclGetOpenFile and OpenFile stuff to tcl.h so that they're
-      accessible to applications.
-    - Extend access modes in open to include the complete set of POSIX
-      access modes (such as O_EXCL and O_NONBLOCK).
-
-11. Re-instate Tcl_WatchInterp to notify application when an interpreter
-is deleted.
-
-12. Add "elseif" mechanism to "if" command for chaining "else {if ..."
-constructs more cleanly.  Require exact matches on "then" and "else"
-keywords.
-
-13. Remove UNIX system call declarations from tclUnix.h.  Use them from
-unistd.h instead, and provide a default version of unistd.h for systems
-that don't have one.
-
-14. Changes in the expr command, mostly following suggestions made by
-George Howlett a long time ago:
-    - Increase precision of floating-point results.
-    - Make floating-point numbers always print with a point.
-    - Add transcendental functions like sin and exp.
-    - Add explicit integer and floating conversion operations.
-    - Don't promote large integers to floating-point automatically.
-    - Allow multiple arguments to expr command.
-
-15. Extend lsort to allow alternate sorting mechanisms, like numeric,
-or client-supplied.
-
-16. Allow alternate pattern-matching forms (e.g. exact or regexp) for
-lsearch and case.
-
-17. Add XPG/3 positional argument specifiers to format (code contributed
-by Mark Diekhans).
-
-18. Change "file readlink" to return an error on systems that don't
-support it rather than removing the option entirely.
-
-19. Add a mechanism for scheduling a Tcl command to be executed when the
-interpreter reaches a clean point.  This is needed for things like
-signal support.
-
-20. Change upvar so that you can refer to an element of an array as
-well as a whole array.
-
-
diff --git a/Todo b/Todo
index d073b04..d8badae 100755 (executable)
--- a/Todo
+++ b/Todo
@@ -1,19 +1,17 @@
-Must-have external packages
-       POSIX
-       X/Motif/whatever
+Modules
+       POSIX (in progress)
+       X/Motif/Tk etc.
+
+Tie Modules
+       VecArray                Implement array using vec()
+       SubstrArray             Implement array using substr()
+       VirtualArray            Implement array using a file
+       ShiftSplice             Defines shift et al in terms of splice method
 
 Bugs
-       BEGIN { require 'perldb.pl' }
        Make yyparse recursion longjmp() proof.
-       perl -c shell_script bug
-       fix the need for double ^D on $x
-       STDOUT->print("howdy\n");
-       %ENV not there
        Make "delete $array{$key} while ($key) = each %array" safe
-       using unpack(P,$ref) shouldn't unref the ref
-       binary function is missing
-       wrong line reported for runtime elsif condition error
-       unreference variable warnings busted (but don't warn on $seen{$key}++)
+       Wrong line reported for runtime elsif condition error
 
 Regexp extensions
        /m  for multiline
@@ -24,16 +22,28 @@ Regexp extensions
        /f for fixed variable interpolation?
        Rewrite regexp parser for better integrated optimization
 
-Nice to have
+Would be nice to have
        Profiler
        pack "(stuff)*"
        lexperl
        Bundled perl preprocessor
-       FILEHANDLE methods
        Make $[ compile-time instead of run-time
+       Use posix calls internally where possible
+       const variables
+       gettimeofday
+       bytecompiler
+       format BOTTOM
+       willcall()
+       -iprefix.
+       All ARGV input should act like <>
+       Multiple levels of warning
+
+Pragmas ("assume" maybe?)
+       integer, float
+       nodebug, debug
+       autocroak?
 
 Optimizations
-       Make specialized allocators
        Optimize switch statements
        Optimize foreach on array
        Optimize foreach (1..1000000)
@@ -44,25 +54,19 @@ Optimizations
        Cache hash value?
        Optimize away @_ where possible
        sfio?
+       "one pass" global destruction
 
 Need to think more about
-       ref in list context
-       When does split() go to @_?
-       Figure out BEGIN { ... @ARGV ... }
-       Implement eval once?  (Unnecessary with cache?)
-       Detect inconsistent linkage when using -DDEBUGGING?
+       ref function in list context
        Populate %SIG at startup if appropriate
-       Multiple levels of warning
+       write HANDLE [formats].
 
 Vague possibilities
-       readonly variables
        sub mysplice(@, $, $, ...)
        data prettyprint function?  (or is it, as I suspect, a lib routine?)
        Nested destructors
        make tr/// return histogram in list context?
        undef wantarray in void context
-       goto &replacement_routine
-       filehandle references
        Loop control on do{} et al
        Explicit switch statements
        perl to C translator
@@ -70,3 +74,4 @@ Vague possibilities
        built-in globbing
        compile to real threaded code
        structured types
+       paren counting in tokener to queue remote expectations
diff --git a/XSUB.h b/XSUB.h
index 764b8e6..a8a193b 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
@@ -1 +1 @@
-#define ST(s) stack_base[sp + s]
+#define ST(s) stack_base[ax + s]
diff --git a/av.c b/av.c
index dd54bd5..7232e8a 100644 (file)
--- a/av.c
+++ b/av.c
@@ -35,11 +35,11 @@ I32 lval;
 {
     SV *sv;
 
-    if (SvMAGICAL(av)) {
+    if (SvRMAGICAL(av)) {
        if (mg_find((SV*)av,'P')) {
            if (key < 0)
                return 0;
-           sv = sv_2mortal(NEWSV(61,0));
+           sv = sv_newmortal();
            mg_copy((SV*)av, sv, 0, key);
            if (!lval) {
                mg_get((SV*)sv);
@@ -62,7 +62,7 @@ I32 lval;
            if (AvREAL(av))
                sv = NEWSV(5,0);
            else
-               sv = sv_mortalcopy(&sv_undef);
+               sv = sv_newmortal();
            return av_store(av,key,sv);
        }
     }
@@ -91,7 +91,7 @@ SV *val;
            return 0;
     }
 
-    if (SvMAGICAL(av)) {
+    if (SvRMAGICAL(av)) {
        if (mg_find((SV*)av,'P')) {
            mg_copy((SV*)av, val, 0, key);
            return 0;
@@ -132,16 +132,16 @@ SV *val;
        if (AvFILL(av) < key) {
            while (++AvFILL(av) < key) {
                if (ary[AvFILL(av)] != Nullsv) {
-                   sv_free(ary[AvFILL(av)]);
+                   SvREFCNT_dec(ary[AvFILL(av)]);
                    ary[AvFILL(av)] = Nullsv;
                }
            }
        }
        if (ary[key])
-           sv_free(ary[key]);
+           SvREFCNT_dec(ary[key]);
     }
     ary[key] = val;
-    if (SvMAGICAL(av)) {
+    if (SvSMAGICAL(av)) {
        MAGIC* mg = SvMAGIC(av);
        sv_magic(val, (SV*)av, tolower(mg->mg_type), 0, key);
        mg_set((SV*)av);
@@ -234,7 +234,7 @@ register AV *av;
        SvPVX(av) = (char*)(AvARRAY(av) - key);
     }
     for (key = 0; key <= AvMAX(av); key++)
-       sv_free(AvARRAY(av)[key]);
+       SvREFCNT_dec(AvARRAY(av)[key]);
     AvFILL(av) = -1;
     Zero(AvARRAY(av), AvMAX(av)+1, SV*);
 }
@@ -254,7 +254,7 @@ register AV *av;
     }
     if (AvREAL(av)) {
        for (key = 0; key <= AvMAX(av); key++)
-           sv_free(AvARRAY(av)[key]);
+           SvREFCNT_dec(AvARRAY(av)[key]);
     }
     Safefree(AvALLOC(av));
     AvALLOC(av) = 0;
@@ -288,7 +288,7 @@ register AV *av;
        return Nullsv;
     retval = AvARRAY(av)[AvFILL(av)];
     AvARRAY(av)[AvFILL(av)--] = Nullsv;
-    if (SvMAGICAL(av))
+    if (SvSMAGICAL(av))
        mg_set((SV*)av);
     return retval;
 }
@@ -352,7 +352,7 @@ register AV *av;
     SvPVX(av) = (char*)(AvARRAY(av) + 1);
     AvMAX(av)--;
     AvFILL(av)--;
-    if (SvMAGICAL(av))
+    if (SvSMAGICAL(av))
        mg_set((SV*)av);
     return retval;
 }
@@ -373,7 +373,7 @@ I32 fill;
        fill = -1;
     if (fill <= AvMAX(av)) {
        AvFILL(av) = fill;
-       if (SvMAGICAL(av))
+       if (SvSMAGICAL(av))
            mg_set((SV*)av);
     }
     else {
diff --git a/bar b/bar
new file mode 100755 (executable)
index 0000000..5288a3e
--- /dev/null
+++ b/bar
@@ -0,0 +1,8 @@
+#!./perl
+
+require POSIX; import POSIX;
+
+print &getpid, "\n";
+
+@uname = &uname;
+print "@uname\n";
diff --git a/bar.pm b/bar.pm
new file mode 100755 (executable)
index 0000000..330c168
--- /dev/null
+++ b/bar.pm
@@ -0,0 +1,10 @@
+#!./perl
+
+print "";
+@c = caller;
+print "@c";
+__END__
+
+require POSIX; import POSIX getpid;
+
+print &getpid, "\n";
diff --git a/bench/fib b/bench/fib
new file mode 100755 (executable)
index 0000000..022d9d0
--- /dev/null
+++ b/bench/fib
@@ -0,0 +1,20 @@
+#!./perl
+
+sub fib
+{
+    ($_[0] < 2) ? $_[0] : &fib($_[0]-1) + &fib($_[0]-2);
+}
+
+sub myruntime
+{
+    local(@t) = times;          #  in seconds
+    $t[0] + $t[1];
+}
+
+$x = (shift || 20);
+print "Starting fib($x)\n";
+$before = &myruntime;
+$y = &fib($x);
+$after = &myruntime;
+printf("Done. Result $y in %g cpu seconds.\n", $after-$before);
+
diff --git a/cflags b/cflags
index 672dfc6..a2cbc62 100755 (executable)
--- a/cflags
+++ b/cflags
@@ -38,48 +38,7 @@ for file do
     : or customize here
 
     case "$file" in
-    array) ;;
-    cmd) ;;
-    cons) ;;
-    consarg) ;;
-    doarg) ;;
-    doio) ;;
-    dolist) ;;
-    dump) ;;
-    eval) ;;
-    form) ;;
-    hash) ;;
-    malloc) ;;
-    perl) ;;
-    perly) ;;
-    regcomp) ;;
-    regexec) ;;
-    stab) ;;
-    str) ;;
-    toke) ;;
-    usersub) ;;
-    util) ;;
-    tarray) ;;
-    tcmd) ;;
-    tcons) ;;
-    tconsarg) ;;
-    tdoarg) ;;
-    tdoio) ;;
-    tdolist) ;;
-    tdump) ;;
-    teval) ;;
-    tform) ;;
-    thash) ;;
-    tmalloc) ;;
-    tperl) ;;
-    tperly) ;;
-    tregcomp) ;;
-    tregexec) ;;
-    tstab) ;;
-    tstr) ;;
-    ttoke) ;;
-    tusersub) ;;
-    tutil) ;;
+    SDBM*) ccflags="$ccflags -pic";;
     *) ;;
     esac
 
diff --git a/configpm b/configpm
new file mode 100755 (executable)
index 0000000..8900d86
--- /dev/null
+++ b/configpm
@@ -0,0 +1,27 @@
+#!./perl
+
+@ARGV = "./config.sh";
+
+undef $/;
+$_ = <>;
+s:^#!/bin/sh\n::;
+s/'undef'/undef/g;
+s/\n(\w+)=/;\n\$Config{'$1'} = /g;
+s/;\n\$Config/\n\$Config/;
+
+open STDOUT, ">lib/Config.pm"
+    or die "Can't open lib/Config.pm: $!\n";
+$myver = sprintf("%.3f", $]);
+print <<"ENDOFBEG";
+package Config;
+require Exporter;
+\@ISA = (Exporter);
+\@EXPORT = qw(%Config);
+
+\$] == $myver or die sprintf
+    "Perl lib version ($myver) doesn't match executable version (%.3f)\\n", \$];
+
+ENDOFBEG
+
+print $_;
+
diff --git a/cop.h b/cop.h
index 0b1868b..acf0fda 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -71,14 +71,12 @@ struct block_sub {
     GV *       dfoutgv;
     AV *       savearray;
     AV *       argarray;
-    AV *       comppad;
     U16                olddepth;
     U8         hasargs;
 };
 
 #define PUSHSUB(cx)                                                    \
        cx->blk_sub.cv = cv;                                            \
-       cx->blk_sub.gv = gv;                                            \
        cx->blk_sub.olddepth = CvDEPTH(cv);                             \
        cx->blk_sub.hasargs = hasargs;
 
@@ -90,12 +88,13 @@ struct block_sub {
 
 #define POPSUB(cx)                                                     \
        if (cx->blk_sub.hasargs) {   /* put back old @_ */              \
-           av_free(cx->blk_sub.argarray);                              \
            GvAV(defgv) = cx->blk_sub.savearray;                        \
        }                                                               \
-       if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) {        \
-           if (CvDELETED(cx->blk_sub.cv))                              \
-               sv_free((SV*)cx->blk_sub.cv);                           \
+       if (cx->blk_sub.cv) {                                           \
+           if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) {    \
+               if (CvDELETED(cx->blk_sub.cv))                          \
+                   SvREFCNT_dec((SV*)cx->blk_sub.cv);                  \
+           }                                                           \
        }
 
 #define POPFORMAT(cx)                                                  \
@@ -109,7 +108,7 @@ struct block_eval {
     OP *       old_eval_root;
 };
 
-#define PUSHEVAL(cx,n)                                                 \
+#define PUSHEVAL(cx,n,fgv)                                             \
        cx->blk_eval.old_in_eval = in_eval;                             \
        cx->blk_eval.old_op_type = op->op_type;                         \
        cx->blk_eval.old_name = n;                                      \
@@ -176,18 +175,17 @@ struct block {
 #define blk_loop       cx_u.cx_blk.blk_u.blku_loop
 
 /* Enter a block. */
-#define PUSHBLOCK(cx,t,s) CXINC, cx = &cxstack[cxstack_ix],            \
+#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix],           \
        cx->cx_type             = t,                                    \
-       cx->blk_oldsp           = s - stack_base,                       \
+       cx->blk_oldsp           = sp - stack_base,                      \
        cx->blk_oldcop          = curcop,                               \
        cx->blk_oldmarksp       = markstack_ptr - markstack,            \
        cx->blk_oldscopesp      = scopestack_ix,                        \
        cx->blk_oldretsp        = retstack_ix,                          \
        cx->blk_oldpm           = curpm,                                \
        cx->blk_gimme           = gimme;                                \
-       if (debug & 4)                                                  \
-           fprintf(stderr,"Entering block %d, type %d\n",              \
-               cxstack_ix, t); 
+       DEBUG_l( fprintf(stderr,"Entering block %d, type %s\n",         \
+                   cxstack_ix, block_type[t]); )
 
 /* Exit a block (RETURN and LAST). */
 #define POPBLOCK(cx) cx = &cxstack[cxstack_ix--],                      \
@@ -198,9 +196,8 @@ struct block {
        retstack_ix     = cx->blk_oldretsp,                             \
        curpm           = cx->blk_oldpm,                                \
        gimme           = cx->blk_gimme;                                \
-       if (debug & 4)                                                  \
-           fprintf(stderr,"Leaving block %d, type %d\n",               \
-               cxstack_ix+1,cx->cx_type);
+       DEBUG_l( fprintf(stderr,"Leaving block %d, type %s\n",          \
+                   cxstack_ix+1,block_type[cx->cx_type]); )
 
 /* Continue a block elsewhere (NEXT and REDO). */
 #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix],                                \
diff --git a/cv.h b/cv.h
index 92dc11b..2675ede 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -22,6 +22,7 @@ struct xpvcv {
     OP *       xcv_root;
     I32              (*xcv_usersub)();
     I32                xcv_userindex;
+    GV *       xcv_gv;
     GV *       xcv_filegv;
     long       xcv_depth;              /* >= 2 indicates recursive call */
     AV *       xcv_padlist;
@@ -33,6 +34,7 @@ struct xpvcv {
 #define CvROOT(sv)     ((XPVCV*)SvANY(sv))->xcv_root
 #define CvUSERSUB(sv)  ((XPVCV*)SvANY(sv))->xcv_usersub
 #define CvUSERINDEX(sv)        ((XPVCV*)SvANY(sv))->xcv_userindex
+#define CvGV(sv)       ((XPVCV*)SvANY(sv))->xcv_gv
 #define CvFILEGV(sv)   ((XPVCV*)SvANY(sv))->xcv_filegv
 #define CvDEPTH(sv)    ((XPVCV*)SvANY(sv))->xcv_depth
 #define CvPADLIST(sv)  ((XPVCV*)SvANY(sv))->xcv_padlist
diff --git a/deb.c b/deb.c
index 0af6110..d052db3 100644 (file)
--- a/deb.c
+++ b/deb.c
 #include "EXTERN.h"
 #include "perl.h"
 
-#ifdef I_VARARGS
-#  include <varargs.h>
+#ifdef STANDARD_C
+#  include <stdarg.h>
+#else
+#  ifdef I_VARARGS
+#    include <varargs.h>
+#  endif
 #endif
 
 void deb_growlevel();
 
-#  ifndef I_VARARGS
+#if !defined(STANDARD_C) && !defined(I_VARARGS)
+
+/*
+ * Fallback on the old hackers way of doing varargs
+ */
+
 /*VARARGS1*/
-void deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
-char *pat;
+void
+deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
+    char *pat;
 {
     register I32 i;
 
-    fprintf(stderr,"%-4ld",(long)curop->cop_line);
+    fprintf(stderr,"(%s:%ld)\t",
+       SvPVX(GvSV(curcop->cop_filegv)),(long)curcop->cop_line);
     for (i=0; i<dlevel; i++)
        fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
     fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
 }
+
+#else /* !defined(STANDARD_C) && !defined(I_VARARGS) */
+
+#  ifdef STANDARD_C
+void
+deb(char *pat, ...)
 #  else
 /*VARARGS1*/
-#ifdef __STDC__
-void deb(char *pat,...)
-#else
-void deb(va_alist)
-va_dcl
-#endif
+void
+deb(pat, va_alist)
+    char *pat;
+    va_dcl
+#  endif
 {
     va_list args;
-    char *pat;
     register I32 i;
 
-    va_start(args);
-    fprintf(stderr,"%-4ld",(long)curcop->cop_line);
+    fprintf(stderr,"(%s:%ld)\t",
+       SvPVX(GvSV(curcop->cop_filegv)),(long)curcop->cop_line);
     for (i=0; i<dlevel; i++)
        fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
 
-    pat = va_arg(args, char *);
+#  if STANDARD_C
+    va_start(args, pat);
+#  else
+    va_start(args);
+#  endif
     (void) vfprintf(stderr,pat,args);
     va_end( args );
 }
-#  endif
+#endif /* !defined(STANDARD_C) && !defined(I_VARARGS) */
 
 void
 deb_growlevel()
diff --git a/dl.c b/dl.c
new file mode 100644 (file)
index 0000000..38a798c
--- /dev/null
+++ b/dl.c
@@ -0,0 +1,54 @@
+#include <dlfcn.h>
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+static int
+XS_DynamicLoader_bootstrap(ix, sp, items)
+register int ix;
+register int sp;
+register int items;
+{
+    if (items < 1 || items > 1) {
+       croak("Usage: DynamicLoader::bootstrap(package)");
+    }
+    {
+       char*   package = SvPV(ST(1),na);
+       void* obj = 0;
+       int (*bootproc)();
+       char tmpbuf[1024];
+       char tmpbuf2[128];
+       AV *av = GvAVn(incgv);
+       I32 i;
+
+       for (i = 0; i <= AvFILL(av); i++) {
+           (void)sprintf(tmpbuf, "%s/auto/%s/%s.so",
+               SvPVx(*av_fetch(av, i, TRUE), na), package, package);
+           if (obj = dlopen(tmpbuf,1))
+               break;
+       }
+       if (!obj)
+           croak("Can't find loadable object for package %s in @INC", package);
+
+       sprintf(tmpbuf2, "boot_%s", package);
+       bootproc = (int (*)())dlsym(obj, tmpbuf2);
+       if (!bootproc)
+           croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2);
+       bootproc();
+
+       ST(0) = sv_mortalcopy(&sv_yes);
+    }
+    return sp;
+}
+
+int
+boot_DynamicLoader(ix,sp,items)
+int ix;
+int sp;
+int items;
+{
+    char* file = __FILE__;
+
+    newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file);
+}
diff --git a/doio.c b/doio.c
index d76cefa..64093bc 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -94,6 +94,7 @@ I32 len;
     FILE *saveofp = Nullfp;
     char savetype = ' ';
 
+    SAVEFREEPV(myname);
     mode[0] = mode[1] = mode[2] = '\0';
     name = myname;
     forkprocess = 1;           /* assume true if no fork */
@@ -101,32 +102,32 @@ I32 len;
        name[--len] = '\0';
     if (!io)
        io = GvIO(gv) = newIO();
-    else if (io->ifp) {
-       fd = fileno(io->ifp);
-       if (io->type == '-')
+    else if (IoIFP(io)) {
+       fd = fileno(IoIFP(io));
+       if (IoTYPE(io) == '-')
            result = 0;
        else if (fd <= maxsysfd) {
-           saveifp = io->ifp;
-           saveofp = io->ofp;
-           savetype = io->type;
+           saveifp = IoIFP(io);
+           saveofp = IoOFP(io);
+           savetype = IoTYPE(io);
            result = 0;
        }
-       else if (io->type == '|')
-           result = my_pclose(io->ifp);
-       else if (io->ifp != io->ofp) {
-           if (io->ofp) {
-               result = fclose(io->ofp);
-               fclose(io->ifp);        /* clear stdio, fd already closed */
+       else if (IoTYPE(io) == '|')
+           result = my_pclose(IoIFP(io));
+       else if (IoIFP(io) != IoOFP(io)) {
+           if (IoOFP(io)) {
+               result = fclose(IoOFP(io));
+               fclose(IoIFP(io));      /* clear stdio, fd already closed */
            }
            else
-               result = fclose(io->ifp);
+               result = fclose(IoIFP(io));
        }
        else
-           result = fclose(io->ifp);
+           result = fclose(IoIFP(io));
        if (result == EOF && fd > maxsysfd)
            fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
              GvENAME(gv));
-       io->ofp = io->ifp = Nullfp;
+       IoOFP(io) = IoIFP(io) = Nullfp;
     }
     if (*name == '+' && len > 1 && name[len-1] != '|') {       /* scary */
        mode[1] = *name++;
@@ -137,7 +138,7 @@ I32 len;
     else  {
        mode[1] = '\0';
     }
-    io->type = *name;
+    IoTYPE(io) = *name;
     if (*name == '|') {
        /*SUPPRESS 530*/
        for (name++; isSPACE(*name); name++) ;
@@ -151,7 +152,7 @@ I32 len;
        TAINT_PROPER("open");
        name++;
        if (*name == '>') {
-           mode[0] = io->type = 'a';
+           mode[0] = IoTYPE(io) = 'a';
            name++;
        }
        else
@@ -172,10 +173,10 @@ I32 len;
 #endif
                    goto say_false;
                }
-               if (GvIO(gv) && GvIO(gv)->ifp) {
-                   fd = fileno(GvIO(gv)->ifp);
-                   if (GvIO(gv)->type == 's')
-                       io->type = 's';
+               if (GvIO(gv) && IoIFP(GvIO(gv))) {
+                   fd = fileno(IoIFP(GvIO(gv)));
+                   if (IoTYPE(GvIO(gv)) == 's')
+                       IoTYPE(io) = 's';
                }
                else
                    fd = -1;
@@ -189,7 +190,7 @@ I32 len;
                name++;
            if (strEQ(name,"-")) {
                fp = stdout;
-               io->type = '-';
+               IoTYPE(io) = '-';
            }
            else  {
                fp = fopen(name,mode);
@@ -206,7 +207,7 @@ I32 len;
                goto duplicity;
            if (strEQ(name,"-")) {
                fp = stdin;
-               io->type = '-';
+               IoTYPE(io) = '-';
            }
            else
                fp = fopen(name,mode);
@@ -221,35 +222,33 @@ I32 len;
                TAINT_ENV();
            TAINT_PROPER("piped open");
            fp = my_popen(name,"r");
-           io->type = '|';
+           IoTYPE(io) = '|';
        }
        else {
-           io->type = '<';
+           IoTYPE(io) = '<';
            /*SUPPRESS 530*/
            for (; isSPACE(*name); name++) ;
            if (strEQ(name,"-")) {
                fp = stdin;
-               io->type = '-';
+               IoTYPE(io) = '-';
            }
            else
                fp = fopen(name,"r");
        }
     }
     if (!fp) {
-       if (dowarn && io->type == '<' && strchr(name, '\n'))
+       if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
            warn(warn_nl, "open");
-       Safefree(myname);
        goto say_false;
     }
-    Safefree(myname);
-    if (io->type &&
-      io->type != '|' && io->type != '-') {
+    if (IoTYPE(io) &&
+      IoTYPE(io) != '|' && IoTYPE(io) != '-') {
        if (fstat(fileno(fp),&statbuf) < 0) {
            (void)fclose(fp);
            goto say_false;
        }
        if (S_ISSOCK(statbuf.st_mode))
-           io->type = 's';     /* in case a socket was passed in to us */
+           IoTYPE(io) = 's';   /* in case a socket was passed in to us */
 #ifdef HAS_SOCKET
        else if (
 #ifdef S_IFMT
@@ -261,7 +260,7 @@ I32 len;
            I32 buflen = sizeof tokenbuf;
            if (getsockname(fileno(fp), tokenbuf, &buflen) >= 0
                || errno != ENOTSOCK)
-               io->type = 's'; /* some OS's return 0 on fstat()ed socket */
+               IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
                                /* but some return 0 for streams too, sigh */
        }
 #endif
@@ -298,25 +297,25 @@ I32 len;
     fd = fileno(fp);
     fcntl(fd,FFt_SETFD,fd > maxsysfd);
 #endif
-    io->ifp = fp;
+    IoIFP(io) = fp;
     if (writing) {
-       if (io->type == 's'
-         || (io->type == '>' && S_ISCHR(statbuf.st_mode)) ) {
-           if (!(io->ofp = fdopen(fileno(fp),"w"))) {
+       if (IoTYPE(io) == 's'
+         || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
+           if (!(IoOFP(io) = fdopen(fileno(fp),"w"))) {
                fclose(fp);
-               io->ifp = Nullfp;
+               IoIFP(io) = Nullfp;
                goto say_false;
            }
        }
        else
-           io->ofp = fp;
+           IoOFP(io) = fp;
     }
     return TRUE;
 
 say_false:
-    io->ifp = saveifp;
-    io->ofp = saveofp;
-    io->type = savetype;
+    IoIFP(io) = saveifp;
+    IoOFP(io) = saveofp;
+    IoTYPE(io) = savetype;
     return FALSE;
 }
 
@@ -335,7 +334,7 @@ register GV *gv;
     if (!argvoutgv)
        argvoutgv = gv_fetchpv("ARGVOUT",TRUE);
     if (filemode & (S_ISUID|S_ISGID)) {
-       fflush(GvIO(argvoutgv)->ifp);  /* chmod must follow last write */
+       fflush(IoIFP(GvIO(argvoutgv)));  /* chmod must follow last write */
 #ifdef HAS_FCHMOD
        (void)fchmod(lastfd,filemode);
 #else
@@ -346,6 +345,7 @@ register GV *gv;
     while (av_len(GvAV(gv)) >= 0) {
        STRLEN len;
        sv = av_shift(GvAV(gv));
+       SAVEFREESV(sv);
        sv_setsv(GvSV(gv),sv);
        SvSETMAGIC(GvSV(gv));
        oldname = SvPVx(GvSV(gv), len);
@@ -353,9 +353,8 @@ register GV *gv;
            if (inplace) {
                TAINT_PROPER("inplace open");
                if (strEQ(oldname,"-")) {
-                   sv_free(sv);
                    defoutgv = gv_fetchpv("STDOUT",TRUE);
-                   return GvIO(gv)->ifp;
+                   return IoIFP(GvIO(gv));
                }
 #ifndef FLEXFILENAMES
                filedev = statbuf.st_dev;
@@ -368,7 +367,6 @@ register GV *gv;
                    warn("Can't do inplace edit: %s is not a regular file",
                      oldname );
                    do_close(gv,FALSE);
-                   sv_free(sv);
                    continue;
                }
                if (*inplace) {
@@ -384,7 +382,6 @@ register GV *gv;
                        warn("Can't do inplace edit: %s > 14 characters",
                          SvPVX(sv) );
                        do_close(gv,FALSE);
-                       sv_free(sv);
                        continue;
                    }
 #endif
@@ -394,7 +391,6 @@ register GV *gv;
                        warn("Can't rename %s to %s: %s, skipping file",
                          oldname, SvPVX(sv), strerror(errno) );
                        do_close(gv,FALSE);
-                       sv_free(sv);
                        continue;
                    }
 #else
@@ -409,7 +405,6 @@ register GV *gv;
                        warn("Can't rename %s to %s: %s, skipping file",
                          oldname, SvPVX(sv), strerror(errno) );
                        do_close(gv,FALSE);
-                       sv_free(sv);
                        continue;
                    }
                    (void)UNLINK(oldname);
@@ -421,7 +416,6 @@ register GV *gv;
                        warn("Can't rename %s to %s: %s, skipping file",
                          oldname, SvPVX(sv), strerror(errno) );
                        do_close(gv,FALSE);
-                       sv_free(sv);
                        continue;
                    }
 #else
@@ -436,11 +430,10 @@ register GV *gv;
                    warn("Can't do inplace edit on %s: %s",
                      oldname, strerror(errno) );
                    do_close(gv,FALSE);
-                   sv_free(sv);
                    continue;
                }
                defoutgv = argvoutgv;
-               lastfd = fileno(GvIO(argvoutgv)->ifp);
+               lastfd = fileno(IoIFP(GvIO(argvoutgv)));
                (void)fstat(lastfd,&statbuf);
 #ifdef HAS_FCHMOD
                (void)fchmod(lastfd,filemode);
@@ -457,12 +450,10 @@ register GV *gv;
 #endif
                }
            }
-           sv_free(sv);
-           return GvIO(gv)->ifp;
+           return IoIFP(GvIO(gv));
        }
        else
            fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), strerror(errno));
-       sv_free(sv);
     }
     if (inplace) {
        (void)do_close(argvoutgv,FALSE);
@@ -492,24 +483,24 @@ GV *wgv;
 
     if (!rstio)
        rstio = GvIO(rgv) = newIO();
-    else if (rstio->ifp)
+    else if (IoIFP(rstio))
        do_close(rgv,FALSE);
     if (!wstio)
        wstio = GvIO(wgv) = newIO();
-    else if (wstio->ifp)
+    else if (IoIFP(wstio))
        do_close(wgv,FALSE);
 
     if (pipe(fd) < 0)
        goto badexit;
-    rstio->ifp = fdopen(fd[0], "r");
-    wstio->ofp = fdopen(fd[1], "w");
-    wstio->ifp = wstio->ofp;
-    rstio->type = '<';
-    wstio->type = '>';
-    if (!rstio->ifp || !wstio->ofp) {
-       if (rstio->ifp) fclose(rstio->ifp);
+    IoIFP(rstio) = fdopen(fd[0], "r");
+    IoOFP(wstio) = fdopen(fd[1], "w");
+    IoIFP(wstio) = IoOFP(wstio);
+    IoTYPE(rstio) = '<';
+    IoTYPE(wstio) = '>';
+    if (!IoIFP(rstio) || !IoOFP(wstio)) {
+       if (IoIFP(rstio)) fclose(IoIFP(rstio));
        else close(fd[0]);
-       if (wstio->ofp) fclose(wstio->ofp);
+       if (IoOFP(wstio)) fclose(IoOFP(wstio));
        else close(fd[1]);
        goto badexit;
     }
@@ -524,9 +515,13 @@ badexit:
 #endif
 
 bool
+#ifndef STANDARD_C
 do_close(gv,explicit)
 GV *gv;
 bool explicit;
+#else
+do_close(GV *gv, bool explicit)
+#endif /* STANDARD_C */
 {
     bool retval = FALSE;
     register IO *io;
@@ -544,30 +539,30 @@ bool explicit;
            warn("Close on unopened file <%s>",GvENAME(gv));
        return FALSE;
     }
-    if (io->ifp) {
-       if (io->type == '|') {
-           status = my_pclose(io->ifp);
+    if (IoIFP(io)) {
+       if (IoTYPE(io) == '|') {
+           status = my_pclose(IoIFP(io));
            retval = (status == 0);
            statusvalue = (unsigned short)status & 0xffff;
        }
-       else if (io->type == '-')
+       else if (IoTYPE(io) == '-')
            retval = TRUE;
        else {
-           if (io->ofp && io->ofp != io->ifp) {                /* a socket */
-               retval = (fclose(io->ofp) != EOF);
-               fclose(io->ifp);        /* clear stdio, fd already closed */
+           if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {          /* a socket */
+               retval = (fclose(IoOFP(io)) != EOF);
+               fclose(IoIFP(io));      /* clear stdio, fd already closed */
            }
            else
-               retval = (fclose(io->ifp) != EOF);
+               retval = (fclose(IoIFP(io)) != EOF);
        }
-       io->ofp = io->ifp = Nullfp;
+       IoOFP(io) = IoIFP(io) = Nullfp;
     }
     if (explicit) {
-       io->lines = 0;
-       io->page = 0;
-       io->lines_left = io->page_len;
+       IoLINES(io) = 0;
+       IoPAGE(io) = 0;
+       IoLINES_LEFT(io) = IoPAGE_LEN(io);
     }
-    io->type = ' ';
+    IoTYPE(io) = ' ';
     return retval;
 }
 
@@ -583,23 +578,23 @@ GV *gv;
     if (!io)
        return TRUE;
 
-    while (io->ifp) {
+    while (IoIFP(io)) {
 
 #ifdef STDSTDIO                        /* (the code works without this) */
-       if (io->ifp->_cnt > 0)  /* cheat a little, since */
+       if (IoIFP(io)->_cnt > 0)        /* cheat a little, since */
            return FALSE;               /* this is the most usual case */
 #endif
 
-       ch = getc(io->ifp);
+       ch = getc(IoIFP(io));
        if (ch != EOF) {
-           (void)ungetc(ch, io->ifp);
+           (void)ungetc(ch, IoIFP(io));
            return FALSE;
        }
 #ifdef STDSTDIO
-       if (io->ifp->_cnt < -1)
-           io->ifp->_cnt = -1;
+       if (IoIFP(io)->_cnt < -1)
+           IoIFP(io)->_cnt = -1;
 #endif
-       if (gv == argvgv) {             /* not necessarily a real EOF yet? */
+       if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
            if (!nextargv(argvgv))      /* get another fp handy */
                return TRUE;
        }
@@ -619,15 +614,15 @@ GV *gv;
        goto phooey;
 
     io = GvIO(gv);
-    if (!io || !io->ifp)
+    if (!io || !IoIFP(io))
        goto phooey;
 
 #ifdef ULTRIX_STDIO_BOTCH
-    if (feof(io->ifp))
-       (void)fseek (io->ifp, 0L, 2);           /* ultrix 1.2 workaround */
+    if (feof(IoIFP(io)))
+       (void)fseek (IoIFP(io), 0L, 2);         /* ultrix 1.2 workaround */
 #endif
 
-    return ftell(io->ifp);
+    return ftell(IoIFP(io));
 
 phooey:
     if (dowarn)
@@ -648,15 +643,15 @@ int whence;
        goto nuts;
 
     io = GvIO(gv);
-    if (!io || !io->ifp)
+    if (!io || !IoIFP(io))
        goto nuts;
 
 #ifdef ULTRIX_STDIO_BOTCH
-    if (feof(io->ifp))
-       (void)fseek (io->ifp, 0L, 2);           /* ultrix 1.2 workaround */
+    if (feof(IoIFP(io)))
+       (void)fseek (IoIFP(io), 0L, 2);         /* ultrix 1.2 workaround */
 #endif
 
-    return fseek(io->ifp, pos, whence) >= 0;
+    return fseek(IoIFP(io), pos, whence) >= 0;
 
 nuts:
     if (dowarn)
@@ -676,7 +671,7 @@ SV *argstr;
     register char *s;
     I32 retval;
 
-    if (!gv || !argstr || !(io = GvIO(gv)) || !io->ifp) {
+    if (!gv || !argstr || !(io = GvIO(gv)) || !IoIFP(io)) {
        errno = EBADF;  /* well, sort of... */
        return -1;
     }
@@ -714,13 +709,13 @@ SV *argstr;
 
 #ifndef lint
     if (optype == OP_IOCTL)
-       retval = ioctl(fileno(io->ifp), func, s);
+       retval = ioctl(fileno(IoIFP(io)), func, s);
     else
 #ifdef DOSISH
        croak("fcntl is not implemented");
 #else
 #ifdef HAS_FCNTL
-       retval = fcntl(fileno(io->ifp), func, s);
+       retval = fcntl(fileno(IoIFP(io)), func, s);
 #else
        croak("fcntl is not implemented");
 #endif
@@ -852,7 +847,7 @@ FILE *fp;
     if (!sv)
        return TRUE;
     if (ofmt) {
-       if (SvMAGICAL(sv))
+       if (SvGMAGICAL(sv))
            mg_get(sv);
         if (SvIOK(sv) && SvIVX(sv) != 0) {
            fprintf(fp, ofmt, (double)SvIVX(sv));
@@ -866,9 +861,11 @@ FILE *fp;
     }
     switch (SvTYPE(sv)) {
     case SVt_NULL:
+       if (dowarn)
+           warn(warn_uninit);
        return TRUE;
     case SVt_IV:
-       if (SvMAGICAL(sv))
+       if (SvGMAGICAL(sv))
            mg_get(sv);
        fprintf(fp, "%d", SvIVX(sv));
        return !ferror(fp);
@@ -891,11 +888,11 @@ dARGS
     if (op->op_flags & OPf_SPECIAL) {
        EXTEND(sp,1);
        io = GvIO(cGVOP->op_gv);
-       if (io && io->ifp) {
+       if (io && IoIFP(io)) {
            statgv = cGVOP->op_gv;
            sv_setpv(statname,"");
            laststype = OP_STAT;
-           return (laststatval = fstat(fileno(io->ifp), &statcache));
+           return (laststatval = fstat(fileno(IoIFP(io)), &statcache));
        }
        else {
            if (cGVOP->op_gv == defgv)
diff --git a/doop.c b/doop.c
index 146bd24..1a2ee51 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -163,8 +163,14 @@ register SV **sp;
     }
 
     if (items-- > 0) {
-       char *s = SvPV(*mark, tmplen);
-       sv_setpvn(sv, s, tmplen);
+       char *s;
+
+       if (*mark) {
+           s = SvPV(*mark, tmplen);
+           sv_setpvn(sv, s, tmplen);
+       }
+       else
+           sv_setpv(sv, "");
        mark++;
     }
     else
@@ -377,10 +383,14 @@ SV *sv;
     SV *targ = LvTARG(sv);
     register I32 offset;
     register I32 size;
-    register unsigned char *s = (unsigned char*)SvPVX(targ);
-    register unsigned long lval = U_L(SvNV(sv));
+    register unsigned char *s;
+    register unsigned long lval;
     I32 mask;
 
+    if (!targ)
+       return;
+    s = (unsigned char*)SvPVX(targ);
+    lval = U_L(SvNV(sv));
     offset = LvTARGOFF(sv);
     size = LvTARGLEN(sv);
     if (size < 8) {
@@ -584,7 +594,7 @@ dARGS
     if (GIMME != G_ARRAY) {
        dTARGET;
 
-       if (!SvMAGICAL(hv) || !mg_find((SV*)hv,'P'))
+       if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
            i = HvKEYS(hv);
        else {
            i = 0;
diff --git a/dump.c b/dump.c
index 7839ed7..5d80a70 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -44,6 +44,8 @@ HV* stash;
     U32        i;
     HE *entry;
 
+    if (!HvARRAY(stash))
+       return;
     for (i = 0; i <= HvMAX(stash); i++) {
        for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
            GV *gv = (GV*)entry->hent_val;
@@ -61,7 +63,7 @@ void
 dump_sub(gv)
 GV* gv;
 {
-    SV *sv = sv_mortalcopy(&sv_undef);
+    SV *sv = sv_newmortal();
     if (GvCV(gv)) {
        gv_fullname(sv,gv);
        dump("\nSUB %s = ", SvPVX(sv));
@@ -107,8 +109,12 @@ register OP *op;
     else
        fprintf(stderr, "DONE\n");
     dumplvl++;
-    if (op->op_targ)
-       dump("TARG = %d\n", op->op_targ);
+    if (op->op_targ) {
+       if (op->op_type == OP_NULL)
+           dump("  (was %s)\n", op_name[op->op_targ]);
+       else
+           dump("TARG = %d\n", op->op_targ);
+    }
 #ifdef NOTDEF
     dump("ADDR = 0x%lx => 0x%lx\n",op, op->op_next);
 #endif
@@ -182,10 +188,12 @@ register OP *op;
     case OP_GVSV:
     case OP_GV:
        if (cGVOP->op_gv) {
+           ENTER;
            tmpsv = NEWSV(0,0);
+           SAVEFREESV(tmpsv);
            gv_fullname(tmpsv,cGVOP->op_gv);
            dump("GV = %s\n", SvPV(tmpsv, na));
-           sv_free(tmpsv);
+           LEAVE;
        }
        else
            dump("GV = NULL\n");
@@ -264,7 +272,7 @@ register GV *gv;
        fprintf(stderr,"{}\n");
        return;
     }
-    sv = sv_mortalcopy(&sv_undef);
+    sv = sv_newmortal();
     dumplvl++;
     fprintf(stderr,"{\n");
     gv_fullname(sv,gv);
diff --git a/embed.h b/embed.h
index 5a9b072..50078b5 100644 (file)
--- a/embed.h
+++ b/embed.h
-/* This file is derived from global.var and interp.var */
+/* This file is derived from global.sym and interp.sym */
 
 /* (Doing namespace management portably in C is really gross.) */
 
 #ifdef EMBED
 
 /* globals we need to hide from the world */
-#define No             PERLNo
-#define Sv             PERLSv
-#define Xpv            PERLXpv
-#define Yes            PERLYes
-#define additem                PERLadditem
-#define an             PERLan
-#define buf            PERLbuf
-#define bufend         PERLbufend
-#define bufptr         PERLbufptr
-#define check          PERLcheck
-#define coeff          PERLcoeff
-#define compiling      PERLcompiling
-#define comppad                PERLcomppad
-#define comppadname    PERLcomppadname
-#define comppadnamefill        PERLcomppadnamefill
-#define cop_seqmax     PERLcop_seqmax
-#define cryptseen      PERLcryptseen
-#define cshlen         PERLcshlen
-#define cshname                PERLcshname
-#define curinterp      PERLcurinterp
-#define curpad         PERLcurpad
-#define dc             PERLdc
-#define di             PERLdi
-#define ds             PERLds
-#define egid           PERLegid
-#define error_count    PERLerror_count
-#define euid           PERLeuid
-#define evstr          PERLevstr
-#define expect         PERLexpect
-#define expectterm     PERLexpectterm
-#define fold           PERLfold
-#define freq           PERLfreq
-#define gid            PERLgid
-#define hexdigit       PERLhexdigit
-#define in_format      PERLin_format
-#define in_my          PERLin_my
-#define know_next      PERLknow_next
-#define last_lop       PERLlast_lop
-#define last_uni       PERLlast_uni
-#define linestr                PERLlinestr
-#define markstack      PERLmarkstack
-#define markstack_max  PERLmarkstack_max
-#define markstack_ptr  PERLmarkstack_ptr
-#define multi_close    PERLmulti_close
-#define multi_end      PERLmulti_end
-#define multi_open     PERLmulti_open
-#define multi_start    PERLmulti_start
-#define na             PERLna
-#define needblockscope PERLneedblockscope
-#define nexttype       PERLnexttype
-#define nextval                PERLnextval
-#define no_aelem       PERLno_aelem
-#define no_dir_func    PERLno_dir_func
-#define no_func                PERLno_func
-#define no_helem       PERLno_helem
-#define no_mem         PERLno_mem
-#define no_modify      PERLno_modify
-#define no_security    PERLno_security
-#define no_sock_func   PERLno_sock_func
-#define no_usym                PERLno_usym
-#define nointrp                PERLnointrp
-#define nomem          PERLnomem
-#define nomemok                PERLnomemok
-#define oldbufptr      PERLoldbufptr
-#define oldoldbufptr   PERLoldoldbufptr
-#define op             PERLop
-#define op_name                PERLop_name
-#define op_seqmax      PERLop_seqmax
-#define opargs         PERLopargs
-#define origalen       PERLorigalen
-#define origenviron    PERLorigenviron
-#define padix          PERLpadix
-#define patleave       PERLpatleave
-#define ppaddr         PERLppaddr
-#define rcsid          PERLrcsid
-#define reall_srchlen  PERLreall_srchlen
-#define regarglen      PERLregarglen
-#define regbol         PERLregbol
-#define regcode                PERLregcode
-#define regdummy       PERLregdummy
-#define regendp                PERLregendp
-#define regeol         PERLregeol
-#define regfold                PERLregfold
-#define reginput       PERLreginput
-#define reglastparen   PERLreglastparen
-#define regmyendp      PERLregmyendp
-#define regmyp_size    PERLregmyp_size
-#define regmystartp    PERLregmystartp
-#define regnarrate     PERLregnarrate
-#define regnpar                PERLregnpar
-#define regparse       PERLregparse
-#define regprecomp     PERLregprecomp
-#define regprev                PERLregprev
-#define regsawback     PERLregsawback
-#define regsawbracket  PERLregsawbracket
-#define regsize                PERLregsize
-#define regstartp      PERLregstartp
-#define regtill                PERLregtill
-#define regxend                PERLregxend
-#define retstack       PERLretstack
-#define retstack_ix    PERLretstack_ix
-#define retstack_max   PERLretstack_max
-#define rsfp           PERLrsfp
-#define savestack      PERLsavestack
-#define savestack_ix   PERLsavestack_ix
-#define savestack_max  PERLsavestack_max
-#define saw_return     PERLsaw_return
-#define scopestack     PERLscopestack
-#define scopestack_ix  PERLscopestack_ix
-#define scopestack_max PERLscopestack_max
-#define scrgv          PERLscrgv
-#define sig_name       PERLsig_name
-#define simple         PERLsimple
-#define stack_base     PERLstack_base
-#define stack_max      PERLstack_max
-#define stack_sp       PERLstack_sp
-#define statbuf                PERLstatbuf
-#define sub_generation PERLsub_generation
-#define subline                PERLsubline
-#define subname                PERLsubname
-#define sv_no          PERLsv_no
-#define sv_undef       PERLsv_undef
-#define sv_yes         PERLsv_yes
-#define thisexpr       PERLthisexpr
-#define timesbuf       PERLtimesbuf
-#define tokenbuf       PERLtokenbuf
-#define uid            PERLuid
-#define varies         PERLvaries
-#define vert           PERLvert
-#define vtbl_arylen    PERLvtbl_arylen
-#define vtbl_bm                PERLvtbl_bm
-#define vtbl_dbline    PERLvtbl_dbline
-#define vtbl_env       PERLvtbl_env
-#define vtbl_envelem   PERLvtbl_envelem
-#define vtbl_glob      PERLvtbl_glob
-#define vtbl_isa       PERLvtbl_isa
-#define vtbl_isaelem   PERLvtbl_isaelem
-#define vtbl_mglob     PERLvtbl_mglob
-#define vtbl_pack      PERLvtbl_pack
-#define vtbl_packelem  PERLvtbl_packelem
-#define vtbl_sig       PERLvtbl_sig
-#define vtbl_sigelem   PERLvtbl_sigelem
-#define vtbl_substr    PERLvtbl_substr
-#define vtbl_sv                PERLvtbl_sv
-#define vtbl_taint     PERLvtbl_taint
-#define vtbl_uvar      PERLvtbl_uvar
-#define vtbl_vec       PERLvtbl_vec
-#define warn_nl                PERLwarn_nl
-#define warn_nosemi    PERLwarn_nosemi
-#define warn_reserved  PERLwarn_reserved
-#define watchaddr      PERLwatchaddr
-#define watchok                PERLwatchok
-#define yychar         PERLyychar
-#define yycheck                PERLyycheck
-#define yydebug                PERLyydebug
-#define yydefred       PERLyydefred
-#define yydgoto                PERLyydgoto
-#define yyerrflag      PERLyyerrflag
-#define yygindex       PERLyygindex
-#define yylen          PERLyylen
-#define yylhs          PERLyylhs
-#define yylval         PERLyylval
-#define yyname         PERLyyname
-#define yynerrs                PERLyynerrs
-#define yyrindex       PERLyyrindex
-#define yyrule         PERLyyrule
-#define yysindex       PERLyysindex
-#define yytable                PERLyytable
-#define yyval          PERLyyval
-#define append_elem    PERLappend_elem
-#define append_list    PERLappend_list
-#define apply          PERLapply
-#define av_clear       PERLav_clear
-#define av_fake                PERLav_fake
-#define av_fetch       PERLav_fetch
-#define av_fill                PERLav_fill
-#define av_free                PERLav_free
-#define av_len         PERLav_len
-#define av_make                PERLav_make
-#define av_pop         PERLav_pop
-#define av_popnulls    PERLav_popnulls
-#define av_push                PERLav_push
-#define av_shift       PERLav_shift
-#define av_store       PERLav_store
-#define av_undef       PERLav_undef
-#define av_unshift     PERLav_unshift
-#define bind_match     PERLbind_match
-#define block_head     PERLblock_head
-#define calllist       PERLcalllist
-#define cando          PERLcando
-#define check_uni      PERLcheck_uni
-#define checkcomma     PERLcheckcomma
-#define ck_aelem       PERLck_aelem
-#define ck_chop                PERLck_chop
-#define ck_concat      PERLck_concat
-#define ck_eof         PERLck_eof
-#define ck_eval                PERLck_eval
-#define ck_exec                PERLck_exec
-#define ck_formline    PERLck_formline
-#define ck_ftst                PERLck_ftst
-#define ck_fun         PERLck_fun
-#define ck_glob                PERLck_glob
-#define ck_grep                PERLck_grep
-#define ck_gvconst     PERLck_gvconst
-#define ck_index       PERLck_index
-#define ck_lengthconst PERLck_lengthconst
-#define ck_lfun                PERLck_lfun
-#define ck_listiob     PERLck_listiob
-#define ck_match       PERLck_match
-#define ck_null                PERLck_null
-#define ck_repeat      PERLck_repeat
-#define ck_retarget    PERLck_retarget
-#define ck_rvconst     PERLck_rvconst
-#define ck_select      PERLck_select
-#define ck_shift       PERLck_shift
-#define ck_sort                PERLck_sort
-#define ck_split       PERLck_split
-#define ck_subr                PERLck_subr
-#define ck_trunc       PERLck_trunc
-#define convert                PERLconvert
-#define cpy7bit                PERLcpy7bit
-#define cpytill                PERLcpytill
-#define croak          PERLcroak
-#define cv_clear       PERLcv_clear
-#define cxinc          PERLcxinc
-#define deb            PERLdeb
-#define deb_growlevel  PERLdeb_growlevel
-#define debop          PERLdebop
-#define debstack       PERLdebstack
-#define debstackptrs   PERLdebstackptrs
-#define die            PERLdie
-#define die_where      PERLdie_where
-#define do_aexec       PERLdo_aexec
-#define do_chop                PERLdo_chop
-#define do_close       PERLdo_close
-#define do_ctl         PERLdo_ctl
-#define do_eof         PERLdo_eof
-#define do_exec                PERLdo_exec
-#define do_execfree    PERLdo_execfree
-#define do_ipcctl      PERLdo_ipcctl
-#define do_ipcget      PERLdo_ipcget
-#define do_join                PERLdo_join
-#define do_kv          PERLdo_kv
-#define do_msgrcv      PERLdo_msgrcv
-#define do_msgsnd      PERLdo_msgsnd
-#define do_open                PERLdo_open
-#define do_pipe                PERLdo_pipe
-#define do_print       PERLdo_print
-#define do_readline    PERLdo_readline
-#define do_seek                PERLdo_seek
-#define do_semop       PERLdo_semop
-#define do_shmio       PERLdo_shmio
-#define do_sprintf     PERLdo_sprintf
-#define do_tell                PERLdo_tell
-#define do_trans       PERLdo_trans
-#define do_vecset      PERLdo_vecset
-#define do_vop         PERLdo_vop
-#define doeval         PERLdoeval
-#define dofindlabel    PERLdofindlabel
-#define dopoptoeval    PERLdopoptoeval
-#define dump_all       PERLdump_all
-#define dump_eval      PERLdump_eval
-#define dump_gv                PERLdump_gv
-#define dump_op                PERLdump_op
-#define dump_packsubs  PERLdump_packsubs
-#define dump_pm                PERLdump_pm
-#define dump_sub       PERLdump_sub
-#define fbm_compile    PERLfbm_compile
-#define fbm_instr      PERLfbm_instr
-#define fetch_gv       PERLfetch_gv
-#define fetch_io       PERLfetch_io
-#define fetch_stash    PERLfetch_stash
-#define fold_constants PERLfold_constants
-#define force_ident    PERLforce_ident
-#define force_next     PERLforce_next
-#define force_word     PERLforce_word
-#define free_tmps      PERLfree_tmps
-#define gen_constant_list      PERLgen_constant_list
-#define getgimme       PERLgetgimme
-#define gp_free                PERLgp_free
-#define gp_ref         PERLgp_ref
-#define gv_AVadd       PERLgv_AVadd
-#define gv_HVadd       PERLgv_HVadd
-#define gv_check       PERLgv_check
-#define gv_efullname   PERLgv_efullname
-#define gv_fetchfile   PERLgv_fetchfile
-#define gv_fetchmeth   PERLgv_fetchmeth
-#define gv_fetchmethod PERLgv_fetchmethod
-#define gv_fetchpv     PERLgv_fetchpv
-#define gv_fullname    PERLgv_fullname
-#define gv_init                PERLgv_init
-#define he_delayfree   PERLhe_delayfree
-#define he_free                PERLhe_free
-#define hoistmust      PERLhoistmust
-#define hv_clear       PERLhv_clear
-#define hv_delete      PERLhv_delete
-#define hv_fetch       PERLhv_fetch
-#define hv_free                PERLhv_free
-#define hv_iterinit    PERLhv_iterinit
-#define hv_iterkey     PERLhv_iterkey
-#define hv_iternext    PERLhv_iternext
-#define hv_iterval     PERLhv_iterval
-#define hv_magic       PERLhv_magic
-#define hv_store       PERLhv_store
-#define hv_undef       PERLhv_undef
-#define ibcmp          PERLibcmp
-#define ingroup                PERLingroup
-#define instr          PERLinstr
-#define intuit_more    PERLintuit_more
-#define invert         PERLinvert
-#define jmaybe         PERLjmaybe
-#define keyword                PERLkeyword
-#define leave_scope    PERLleave_scope
-#define lex_end                PERLlex_end
-#define lex_start      PERLlex_start
-#define linklist       PERLlinklist
-#define list           PERLlist
-#define listkids       PERLlistkids
-#define localize       PERLlocalize
-#define looks_like_number      PERLlooks_like_number
-#define magic_clearpack        PERLmagic_clearpack
-#define magic_get      PERLmagic_get
-#define magic_getarylen        PERLmagic_getarylen
-#define magic_getglob  PERLmagic_getglob
-#define magic_getpack  PERLmagic_getpack
-#define magic_gettaint PERLmagic_gettaint
-#define magic_getuvar  PERLmagic_getuvar
-#define magic_len      PERLmagic_len
-#define magic_nextpack PERLmagic_nextpack
-#define magic_set      PERLmagic_set
-#define magic_setarylen        PERLmagic_setarylen
-#define magic_setbm    PERLmagic_setbm
-#define magic_setdbline        PERLmagic_setdbline
-#define magic_setenv   PERLmagic_setenv
-#define magic_setglob  PERLmagic_setglob
-#define magic_setisa   PERLmagic_setisa
-#define magic_setmglob PERLmagic_setmglob
-#define magic_setpack  PERLmagic_setpack
-#define magic_setsig   PERLmagic_setsig
-#define magic_setsubstr        PERLmagic_setsubstr
-#define magic_settaint PERLmagic_settaint
-#define magic_setuvar  PERLmagic_setuvar
-#define magic_setvec   PERLmagic_setvec
-#define magicname      PERLmagicname
-#define mess           PERLmess
-#define mg_clear       PERLmg_clear
-#define mg_copy                PERLmg_copy
-#define mg_find                PERLmg_find
-#define mg_free                PERLmg_free
-#define mg_get         PERLmg_get
-#define mg_len         PERLmg_len
-#define mg_set         PERLmg_set
-#define mod            PERLmod
-#define modkids                PERLmodkids
-#define moreswitches   PERLmoreswitches
-#define my             PERLmy
-#define my_exit                PERLmy_exit
-#define my_lstat       PERLmy_lstat
-#define my_pclose      PERLmy_pclose
-#define my_popen       PERLmy_popen
-#define my_setenv      PERLmy_setenv
-#define my_stat                PERLmy_stat
-#define my_unexec      PERLmy_unexec
-#define newANONHASH    PERLnewANONHASH
-#define newANONLIST    PERLnewANONLIST
-#define newASSIGNOP    PERLnewASSIGNOP
-#define newAV          PERLnewAV
-#define newAVREF       PERLnewAVREF
-#define newBINOP       PERLnewBINOP
-#define newCONDOP      PERLnewCONDOP
-#define newCVOP                PERLnewCVOP
-#define newCVREF       PERLnewCVREF
-#define newFORM                PERLnewFORM
-#define newFOROP       PERLnewFOROP
-#define newGVOP                PERLnewGVOP
-#define newGVREF       PERLnewGVREF
-#define newGVgen       PERLnewGVgen
-#define newHV          PERLnewHV
-#define newHVREF       PERLnewHVREF
-#define newIO          PERLnewIO
-#define newLISTOP      PERLnewLISTOP
-#define newLOGOP       PERLnewLOGOP
-#define newLOOPOP      PERLnewLOOPOP
-#define newMETHOD      PERLnewMETHOD
-#define newNULLLIST    PERLnewNULLLIST
-#define newOP          PERLnewOP
-#define newPMOP                PERLnewPMOP
-#define newPVOP                PERLnewPVOP
-#define newRANGE       PERLnewRANGE
-#define newSLICEOP     PERLnewSLICEOP
-#define newSTATEOP     PERLnewSTATEOP
-#define newSUB         PERLnewSUB
-#define newSV          PERLnewSV
-#define newSVOP                PERLnewSVOP
-#define newSVREF       PERLnewSVREF
-#define newSViv                PERLnewSViv
-#define newSVnv                PERLnewSVnv
-#define newSVpv                PERLnewSVpv
-#define newSVsv                PERLnewSVsv
-#define newUNOP                PERLnewUNOP
-#define newWHILEOP     PERLnewWHILEOP
-#define newXSUB                PERLnewXSUB
-#define nextargv       PERLnextargv
-#define ninstr         PERLninstr
-#define no_fh_allowed  PERLno_fh_allowed
-#define no_op          PERLno_op
-#define nsavestr       PERLnsavestr
-#define oopsAV         PERLoopsAV
-#define oopsCV         PERLoopsCV
-#define oopsHV         PERLoopsHV
-#define op_free                PERLop_free
-#define package                PERLpackage
-#define pad_alloc      PERLpad_alloc
-#define pad_allocmy    PERLpad_allocmy
-#define pad_findmy     PERLpad_findmy
-#define pad_free       PERLpad_free
-#define pad_leavemy    PERLpad_leavemy
-#define pad_reset      PERLpad_reset
-#define pad_sv         PERLpad_sv
-#define pad_swipe      PERLpad_swipe
-#define peep           PERLpeep
-#define pidgone                PERLpidgone
-#define pmruntime      PERLpmruntime
-#define pmtrans                PERLpmtrans
-#define pop_return     PERLpop_return
-#define pop_scope      PERLpop_scope
-#define pp_aassign     PERLpp_aassign
-#define pp_accept      PERLpp_accept
-#define pp_add         PERLpp_add
-#define pp_aelem       PERLpp_aelem
-#define pp_aelemfast   PERLpp_aelemfast
-#define pp_alarm       PERLpp_alarm
-#define pp_and         PERLpp_and
-#define pp_andassign   PERLpp_andassign
-#define pp_anonhash    PERLpp_anonhash
-#define pp_anonlist    PERLpp_anonlist
-#define pp_aslice      PERLpp_aslice
-#define pp_atan2       PERLpp_atan2
-#define pp_av2arylen   PERLpp_av2arylen
-#define pp_backtick    PERLpp_backtick
-#define pp_bind                PERLpp_bind
-#define pp_binmode     PERLpp_binmode
-#define pp_bit_and     PERLpp_bit_and
-#define pp_bit_or      PERLpp_bit_or
-#define pp_bless       PERLpp_bless
-#define pp_caller      PERLpp_caller
-#define pp_chdir       PERLpp_chdir
-#define pp_chmod       PERLpp_chmod
-#define pp_chop                PERLpp_chop
-#define pp_chown       PERLpp_chown
-#define pp_chroot      PERLpp_chroot
-#define pp_close       PERLpp_close
-#define pp_closedir    PERLpp_closedir
-#define pp_complement  PERLpp_complement
-#define pp_concat      PERLpp_concat
-#define pp_cond_expr   PERLpp_cond_expr
-#define pp_connect     PERLpp_connect
-#define pp_const       PERLpp_const
-#define pp_cos         PERLpp_cos
-#define pp_crypt       PERLpp_crypt
-#define pp_cswitch     PERLpp_cswitch
-#define pp_dbmclose    PERLpp_dbmclose
-#define pp_dbmopen     PERLpp_dbmopen
-#define pp_dbstate     PERLpp_dbstate
-#define pp_defined     PERLpp_defined
-#define pp_delete      PERLpp_delete
-#define pp_die         PERLpp_die
-#define pp_divide      PERLpp_divide
-#define pp_dofile      PERLpp_dofile
-#define pp_done                PERLpp_done
-#define pp_dump                PERLpp_dump
-#define pp_each                PERLpp_each
-#define pp_egrent      PERLpp_egrent
-#define pp_ehostent    PERLpp_ehostent
-#define pp_enetent     PERLpp_enetent
-#define pp_enter       PERLpp_enter
-#define pp_entereval   PERLpp_entereval
-#define pp_enteriter   PERLpp_enteriter
-#define pp_enterloop   PERLpp_enterloop
-#define pp_entersubr   PERLpp_entersubr
-#define pp_entertry    PERLpp_entertry
-#define pp_enterwrite  PERLpp_enterwrite
-#define pp_eof         PERLpp_eof
-#define pp_eprotoent   PERLpp_eprotoent
-#define pp_epwent      PERLpp_epwent
-#define pp_eq          PERLpp_eq
-#define pp_eservent    PERLpp_eservent
-#define pp_evalonce    PERLpp_evalonce
-#define pp_exec                PERLpp_exec
-#define pp_exit                PERLpp_exit
-#define pp_exp         PERLpp_exp
-#define pp_fcntl       PERLpp_fcntl
-#define pp_fileno      PERLpp_fileno
-#define pp_flip                PERLpp_flip
-#define pp_flock       PERLpp_flock
-#define pp_flop                PERLpp_flop
-#define pp_fork                PERLpp_fork
-#define pp_formline    PERLpp_formline
-#define pp_ftatime     PERLpp_ftatime
-#define pp_ftbinary    PERLpp_ftbinary
-#define pp_ftblk       PERLpp_ftblk
-#define pp_ftchr       PERLpp_ftchr
-#define pp_ftctime     PERLpp_ftctime
-#define pp_ftdir       PERLpp_ftdir
-#define pp_fteexec     PERLpp_fteexec
-#define pp_fteowned    PERLpp_fteowned
-#define pp_fteread     PERLpp_fteread
-#define pp_ftewrite    PERLpp_ftewrite
-#define pp_ftfile      PERLpp_ftfile
-#define pp_ftis                PERLpp_ftis
-#define pp_ftlink      PERLpp_ftlink
-#define pp_ftmtime     PERLpp_ftmtime
-#define pp_ftpipe      PERLpp_ftpipe
-#define pp_ftrexec     PERLpp_ftrexec
-#define pp_ftrowned    PERLpp_ftrowned
-#define pp_ftrread     PERLpp_ftrread
-#define pp_ftrwrite    PERLpp_ftrwrite
-#define pp_ftsgid      PERLpp_ftsgid
-#define pp_ftsize      PERLpp_ftsize
-#define pp_ftsock      PERLpp_ftsock
-#define pp_ftsuid      PERLpp_ftsuid
-#define pp_ftsvtx      PERLpp_ftsvtx
-#define pp_fttext      PERLpp_fttext
-#define pp_fttty       PERLpp_fttty
-#define pp_ftzero      PERLpp_ftzero
-#define pp_ge          PERLpp_ge
-#define pp_getc                PERLpp_getc
-#define pp_getlogin    PERLpp_getlogin
-#define pp_getpeername PERLpp_getpeername
-#define pp_getpgrp     PERLpp_getpgrp
-#define pp_getppid     PERLpp_getppid
-#define pp_getpriority PERLpp_getpriority
-#define pp_getsockname PERLpp_getsockname
-#define pp_ggrent      PERLpp_ggrent
-#define pp_ggrgid      PERLpp_ggrgid
-#define pp_ggrnam      PERLpp_ggrnam
-#define pp_ghbyaddr    PERLpp_ghbyaddr
-#define pp_ghbyname    PERLpp_ghbyname
-#define pp_ghostent    PERLpp_ghostent
-#define pp_glob                PERLpp_glob
-#define pp_gmtime      PERLpp_gmtime
-#define pp_gnbyaddr    PERLpp_gnbyaddr
-#define pp_gnbyname    PERLpp_gnbyname
-#define pp_gnetent     PERLpp_gnetent
-#define pp_goto                PERLpp_goto
-#define pp_gpbyname    PERLpp_gpbyname
-#define pp_gpbynumber  PERLpp_gpbynumber
-#define pp_gprotoent   PERLpp_gprotoent
-#define pp_gpwent      PERLpp_gpwent
-#define pp_gpwnam      PERLpp_gpwnam
-#define pp_gpwuid      PERLpp_gpwuid
-#define pp_grepstart   PERLpp_grepstart
-#define pp_grepwhile   PERLpp_grepwhile
-#define pp_gsbyname    PERLpp_gsbyname
-#define pp_gsbyport    PERLpp_gsbyport
-#define pp_gservent    PERLpp_gservent
-#define pp_gsockopt    PERLpp_gsockopt
-#define pp_gt          PERLpp_gt
-#define pp_gv          PERLpp_gv
-#define pp_gvsv                PERLpp_gvsv
-#define pp_helem       PERLpp_helem
-#define pp_hex         PERLpp_hex
-#define pp_hslice      PERLpp_hslice
-#define pp_index       PERLpp_index
-#define pp_indread     PERLpp_indread
-#define pp_int         PERLpp_int
-#define pp_intadd      PERLpp_intadd
-#define pp_interp      PERLpp_interp
-#define pp_ioctl       PERLpp_ioctl
-#define pp_iter                PERLpp_iter
-#define pp_join                PERLpp_join
-#define pp_keys                PERLpp_keys
-#define pp_kill                PERLpp_kill
-#define pp_last                PERLpp_last
-#define pp_lc          PERLpp_lc
-#define pp_lcfirst     PERLpp_lcfirst
-#define pp_le          PERLpp_le
-#define pp_leave       PERLpp_leave
-#define pp_leaveeval   PERLpp_leaveeval
-#define pp_leaveloop   PERLpp_leaveloop
-#define pp_leavesubr   PERLpp_leavesubr
-#define pp_leavetry    PERLpp_leavetry
-#define pp_leavewrite  PERLpp_leavewrite
-#define pp_left_shift  PERLpp_left_shift
-#define pp_length      PERLpp_length
-#define pp_lineseq     PERLpp_lineseq
-#define pp_link                PERLpp_link
-#define pp_list                PERLpp_list
-#define pp_listen      PERLpp_listen
-#define pp_localtime   PERLpp_localtime
-#define pp_log         PERLpp_log
-#define pp_lslice      PERLpp_lslice
-#define pp_lstat       PERLpp_lstat
-#define pp_lt          PERLpp_lt
-#define pp_match       PERLpp_match
-#define pp_method      PERLpp_method
-#define pp_mkdir       PERLpp_mkdir
-#define pp_modulo      PERLpp_modulo
-#define pp_msgctl      PERLpp_msgctl
-#define pp_msgget      PERLpp_msgget
-#define pp_msgrcv      PERLpp_msgrcv
-#define pp_msgsnd      PERLpp_msgsnd
-#define pp_multiply    PERLpp_multiply
-#define pp_ncmp                PERLpp_ncmp
-#define pp_ne          PERLpp_ne
-#define pp_negate      PERLpp_negate
-#define pp_next                PERLpp_next
-#define pp_nextstate   PERLpp_nextstate
-#define pp_not         PERLpp_not
-#define pp_nswitch     PERLpp_nswitch
-#define pp_null                PERLpp_null
-#define pp_oct         PERLpp_oct
-#define pp_open                PERLpp_open
-#define pp_open_dir    PERLpp_open_dir
-#define pp_or          PERLpp_or
-#define pp_orassign    PERLpp_orassign
-#define pp_ord         PERLpp_ord
-#define pp_pack                PERLpp_pack
-#define pp_padav       PERLpp_padav
-#define pp_padhv       PERLpp_padhv
-#define pp_padsv       PERLpp_padsv
-#define pp_pipe_op     PERLpp_pipe_op
-#define pp_pop         PERLpp_pop
-#define pp_postdec     PERLpp_postdec
-#define pp_postinc     PERLpp_postinc
-#define pp_pow         PERLpp_pow
-#define pp_predec      PERLpp_predec
-#define pp_preinc      PERLpp_preinc
-#define pp_print       PERLpp_print
-#define pp_prtf                PERLpp_prtf
-#define pp_push                PERLpp_push
-#define pp_pushmark    PERLpp_pushmark
-#define pp_pushre      PERLpp_pushre
-#define pp_rand                PERLpp_rand
-#define pp_range       PERLpp_range
-#define pp_rcatline    PERLpp_rcatline
-#define pp_read                PERLpp_read
-#define pp_readdir     PERLpp_readdir
-#define pp_readline    PERLpp_readline
-#define pp_readlink    PERLpp_readlink
-#define pp_recv                PERLpp_recv
-#define pp_redo                PERLpp_redo
-#define pp_ref         PERLpp_ref
-#define pp_refgen      PERLpp_refgen
-#define pp_regcmaybe   PERLpp_regcmaybe
-#define pp_regcomp     PERLpp_regcomp
-#define pp_rename      PERLpp_rename
-#define pp_repeat      PERLpp_repeat
-#define pp_require     PERLpp_require
-#define pp_reset       PERLpp_reset
-#define pp_return      PERLpp_return
-#define pp_reverse     PERLpp_reverse
-#define pp_rewinddir   PERLpp_rewinddir
-#define pp_right_shift PERLpp_right_shift
-#define pp_rindex      PERLpp_rindex
-#define pp_rmdir       PERLpp_rmdir
-#define pp_rv2av       PERLpp_rv2av
-#define pp_rv2cv       PERLpp_rv2cv
-#define pp_rv2gv       PERLpp_rv2gv
-#define pp_rv2hv       PERLpp_rv2hv
-#define pp_rv2sv       PERLpp_rv2sv
-#define pp_sassign     PERLpp_sassign
-#define pp_scalar      PERLpp_scalar
-#define pp_schop       PERLpp_schop
-#define pp_scmp                PERLpp_scmp
-#define pp_scope       PERLpp_scope
-#define pp_seek                PERLpp_seek
-#define pp_seekdir     PERLpp_seekdir
-#define pp_select      PERLpp_select
-#define pp_semctl      PERLpp_semctl
-#define pp_semget      PERLpp_semget
-#define pp_semop       PERLpp_semop
-#define pp_send                PERLpp_send
-#define pp_seq         PERLpp_seq
-#define pp_setpgrp     PERLpp_setpgrp
-#define pp_setpriority PERLpp_setpriority
-#define pp_sge         PERLpp_sge
-#define pp_sgrent      PERLpp_sgrent
-#define pp_sgt         PERLpp_sgt
-#define pp_shift       PERLpp_shift
-#define pp_shmctl      PERLpp_shmctl
-#define pp_shmget      PERLpp_shmget
-#define pp_shmread     PERLpp_shmread
-#define pp_shmwrite    PERLpp_shmwrite
-#define pp_shostent    PERLpp_shostent
-#define pp_shutdown    PERLpp_shutdown
-#define pp_sin         PERLpp_sin
-#define pp_sle         PERLpp_sle
-#define pp_sleep       PERLpp_sleep
-#define pp_slt         PERLpp_slt
-#define pp_sne         PERLpp_sne
-#define pp_snetent     PERLpp_snetent
-#define pp_socket      PERLpp_socket
-#define pp_sockpair    PERLpp_sockpair
-#define pp_sort                PERLpp_sort
-#define pp_splice      PERLpp_splice
-#define pp_split       PERLpp_split
-#define pp_sprintf     PERLpp_sprintf
-#define pp_sprotoent   PERLpp_sprotoent
-#define pp_spwent      PERLpp_spwent
-#define pp_sqrt                PERLpp_sqrt
-#define pp_srand       PERLpp_srand
-#define pp_sselect     PERLpp_sselect
-#define pp_sservent    PERLpp_sservent
-#define pp_ssockopt    PERLpp_ssockopt
-#define pp_stat                PERLpp_stat
-#define pp_stub                PERLpp_stub
-#define pp_study       PERLpp_study
-#define pp_subst       PERLpp_subst
-#define pp_substcont   PERLpp_substcont
-#define pp_substr      PERLpp_substr
-#define pp_subtract    PERLpp_subtract
-#define pp_sv2len      PERLpp_sv2len
-#define pp_symlink     PERLpp_symlink
-#define pp_syscall     PERLpp_syscall
-#define pp_sysread     PERLpp_sysread
-#define pp_system      PERLpp_system
-#define pp_syswrite    PERLpp_syswrite
-#define pp_tell                PERLpp_tell
-#define pp_telldir     PERLpp_telldir
-#define pp_tie         PERLpp_tie
-#define pp_time                PERLpp_time
-#define pp_tms         PERLpp_tms
-#define pp_trans       PERLpp_trans
-#define pp_truncate    PERLpp_truncate
-#define pp_uc          PERLpp_uc
-#define pp_ucfirst     PERLpp_ucfirst
-#define pp_umask       PERLpp_umask
-#define pp_undef       PERLpp_undef
-#define pp_unlink      PERLpp_unlink
-#define pp_unpack      PERLpp_unpack
-#define pp_unshift     PERLpp_unshift
-#define pp_unstack     PERLpp_unstack
-#define pp_untie       PERLpp_untie
-#define pp_utime       PERLpp_utime
-#define pp_values      PERLpp_values
-#define pp_vec         PERLpp_vec
-#define pp_wait                PERLpp_wait
-#define pp_waitpid     PERLpp_waitpid
-#define pp_wantarray   PERLpp_wantarray
-#define pp_warn                PERLpp_warn
-#define pp_xor         PERLpp_xor
-#define prepend_elem   PERLprepend_elem
-#define push_return    PERLpush_return
-#define push_scope     PERLpush_scope
-#define pv_grow                PERLpv_grow
-#define q              PERLq
-#define ref            PERLref
-#define refkids                PERLrefkids
-#define regcomp                PERLregcomp
-#define regdump                PERLregdump
-#define regexec                PERLregexec
-#define regfree                PERLregfree
-#define regnext                PERLregnext
-#define regprop                PERLregprop
-#define repeatcpy      PERLrepeatcpy
-#define rninstr                PERLrninstr
-#define run            PERLrun
-#define save_I32       PERLsave_I32
-#define save_aptr      PERLsave_aptr
-#define save_ary       PERLsave_ary
-#define save_hash      PERLsave_hash
-#define save_hptr      PERLsave_hptr
-#define save_int       PERLsave_int
-#define save_item      PERLsave_item
-#define save_list      PERLsave_list
-#define save_nogv      PERLsave_nogv
-#define save_scalar    PERLsave_scalar
-#define save_sptr      PERLsave_sptr
-#define save_svref     PERLsave_svref
-#define savestack_grow PERLsavestack_grow
-#define savestr                PERLsavestr
-#define sawparens      PERLsawparens
-#define scalar         PERLscalar
-#define scalarkids     PERLscalarkids
-#define scalarseq      PERLscalarseq
-#define scalarvoid     PERLscalarvoid
-#define scan_const     PERLscan_const
-#define scan_formline  PERLscan_formline
-#define scan_heredoc   PERLscan_heredoc
-#define scan_hex       PERLscan_hex
-#define scan_ident     PERLscan_ident
-#define scan_inputsymbol       PERLscan_inputsymbol
-#define scan_num       PERLscan_num
-#define scan_oct       PERLscan_oct
-#define scan_pat       PERLscan_pat
-#define scan_prefix    PERLscan_prefix
-#define scan_str       PERLscan_str
-#define scan_subst     PERLscan_subst
-#define scan_trans     PERLscan_trans
-#define scan_word      PERLscan_word
-#define scope          PERLscope
-#define screaminstr    PERLscreaminstr
-#define setenv_getix   PERLsetenv_getix
-#define skipspace      PERLskipspace
-#define sublex_done    PERLsublex_done
-#define sublex_start   PERLsublex_start
-#define sv_2bool       PERLsv_2bool
-#define sv_2cv         PERLsv_2cv
-#define sv_2iv         PERLsv_2iv
-#define sv_2mortal     PERLsv_2mortal
-#define sv_2nv         PERLsv_2nv
-#define sv_2pv         PERLsv_2pv
-#define sv_backoff     PERLsv_backoff
-#define sv_catpv       PERLsv_catpv
-#define sv_catpvn      PERLsv_catpvn
-#define sv_catsv       PERLsv_catsv
-#define sv_chop                PERLsv_chop
-#define sv_clear       PERLsv_clear
-#define sv_cmp         PERLsv_cmp
-#define sv_dec         PERLsv_dec
-#define sv_eq          PERLsv_eq
-#define sv_free                PERLsv_free
-#define sv_gets                PERLsv_gets
-#define sv_grow                PERLsv_grow
-#define sv_inc         PERLsv_inc
-#define sv_insert      PERLsv_insert
-#define sv_isa         PERLsv_isa
-#define sv_len         PERLsv_len
-#define sv_magic       PERLsv_magic
-#define sv_mortalcopy  PERLsv_mortalcopy
-#define sv_peek                PERLsv_peek
-#define sv_ref         PERLsv_ref
-#define sv_replace     PERLsv_replace
-#define sv_reset       PERLsv_reset
-#define sv_setiv       PERLsv_setiv
-#define sv_setnv       PERLsv_setnv
-#define sv_setptrobj   PERLsv_setptrobj
-#define sv_setpv       PERLsv_setpv
-#define sv_setpvn      PERLsv_setpvn
-#define sv_setsv       PERLsv_setsv
-#define sv_unmagic     PERLsv_unmagic
-#define sv_upgrade     PERLsv_upgrade
-#define sv_usepvn      PERLsv_usepvn
-#define taint_env      PERLtaint_env
-#define taint_not      PERLtaint_not
-#define taint_proper   PERLtaint_proper
-#define too_few_arguments      PERLtoo_few_arguments
-#define too_many_arguments     PERLtoo_many_arguments
-#define wait4pid       PERLwait4pid
-#define warn           PERLwarn
-#define watch          PERLwatch
-#define whichsig       PERLwhichsig
-#define yyerror                PERLyyerror
-#define yylex          PERLyylex
-#define yyparse                PERLyyparse
+#define No             perl_No
+#define Sv             perl_Sv
+#define Xpv            perl_Xpv
+#define Yes            perl_Yes
+#define additem                perl_additem
+#define an             perl_an
+#define buf            perl_buf
+#define bufend         perl_bufend
+#define bufptr         perl_bufptr
+#define check          perl_check
+#define coeff          perl_coeff
+#define compiling      perl_compiling
+#define comppad                perl_comppad
+#define comppad_name   perl_comppad_name
+#define comppad_name_fill      perl_comppad_name_fill
+#define cop_seqmax     perl_cop_seqmax
+#define cryptseen      perl_cryptseen
+#define cshlen         perl_cshlen
+#define cshname                perl_cshname
+#define curinterp      perl_curinterp
+#define curpad         perl_curpad
+#define dc             perl_dc
+#define di             perl_di
+#define ds             perl_ds
+#define egid           perl_egid
+#define error_count    perl_error_count
+#define euid           perl_euid
+#define evalseq                perl_evalseq
+#define evstr          perl_evstr
+#define expect         perl_expect
+#define expectterm     perl_expectterm
+#define fold           perl_fold
+#define freq           perl_freq
+#define gid            perl_gid
+#define hexdigit       perl_hexdigit
+#define in_format      perl_in_format
+#define in_my          perl_in_my
+#define know_next      perl_know_next
+#define last_lop       perl_last_lop
+#define last_lop_op    perl_last_lop_op
+#define last_uni       perl_last_uni
+#define linestr                perl_linestr
+#define markstack      perl_markstack
+#define markstack_max  perl_markstack_max
+#define markstack_ptr  perl_markstack_ptr
+#define max_intro_pending      perl_max_intro_pending
+#define min_intro_pending      perl_min_intro_pending
+#define multi_close    perl_multi_close
+#define multi_end      perl_multi_end
+#define multi_open     perl_multi_open
+#define multi_start    perl_multi_start
+#define na             perl_na
+#define needblockscope perl_needblockscope
+#define nexttype       perl_nexttype
+#define nextval                perl_nextval
+#define no_aelem       perl_no_aelem
+#define no_dir_func    perl_no_dir_func
+#define no_func                perl_no_func
+#define no_helem       perl_no_helem
+#define no_mem         perl_no_mem
+#define no_modify      perl_no_modify
+#define no_security    perl_no_security
+#define no_sock_func   perl_no_sock_func
+#define no_usym                perl_no_usym
+#define nointrp                perl_nointrp
+#define nomem          perl_nomem
+#define nomemok                perl_nomemok
+#define oldbufptr      perl_oldbufptr
+#define oldoldbufptr   perl_oldoldbufptr
+#define op             perl_op
+#define op_name                perl_op_name
+#define op_seqmax      perl_op_seqmax
+#define opargs         perl_opargs
+#define origalen       perl_origalen
+#define origenviron    perl_origenviron
+#define padix          perl_padix
+#define patleave       perl_patleave
+#define ppaddr         perl_ppaddr
+#define rcsid          perl_rcsid
+#define reall_srchlen  perl_reall_srchlen
+#define regarglen      perl_regarglen
+#define regbol         perl_regbol
+#define regcode                perl_regcode
+#define regdummy       perl_regdummy
+#define regendp                perl_regendp
+#define regeol         perl_regeol
+#define regfold                perl_regfold
+#define reginput       perl_reginput
+#define reglastparen   perl_reglastparen
+#define regmyendp      perl_regmyendp
+#define regmyp_size    perl_regmyp_size
+#define regmystartp    perl_regmystartp
+#define regnarrate     perl_regnarrate
+#define regnpar                perl_regnpar
+#define regparse       perl_regparse
+#define regprecomp     perl_regprecomp
+#define regprev                perl_regprev
+#define regsawback     perl_regsawback
+#define regsawbracket  perl_regsawbracket
+#define regsize                perl_regsize
+#define regstartp      perl_regstartp
+#define regtill                perl_regtill
+#define regxend                perl_regxend
+#define retstack       perl_retstack
+#define retstack_ix    perl_retstack_ix
+#define retstack_max   perl_retstack_max
+#define rsfp           perl_rsfp
+#define savestack      perl_savestack
+#define savestack_ix   perl_savestack_ix
+#define savestack_max  perl_savestack_max
+#define saw_return     perl_saw_return
+#define scopestack     perl_scopestack
+#define scopestack_ix  perl_scopestack_ix
+#define scopestack_max perl_scopestack_max
+#define scrgv          perl_scrgv
+#define sig_name       perl_sig_name
+#define simple         perl_simple
+#define stack_base     perl_stack_base
+#define stack_max      perl_stack_max
+#define stack_sp       perl_stack_sp
+#define statbuf                perl_statbuf
+#define sub_generation perl_sub_generation
+#define subline                perl_subline
+#define subname                perl_subname
+#define sv_no          perl_sv_no
+#define sv_undef       perl_sv_undef
+#define sv_yes         perl_sv_yes
+#define thisexpr       perl_thisexpr
+#define timesbuf       perl_timesbuf
+#define tokenbuf       perl_tokenbuf
+#define uid            perl_uid
+#define varies         perl_varies
+#define vert           perl_vert
+#define vtbl_arylen    perl_vtbl_arylen
+#define vtbl_bm                perl_vtbl_bm
+#define vtbl_dbline    perl_vtbl_dbline
+#define vtbl_env       perl_vtbl_env
+#define vtbl_envelem   perl_vtbl_envelem
+#define vtbl_glob      perl_vtbl_glob
+#define vtbl_isa       perl_vtbl_isa
+#define vtbl_isaelem   perl_vtbl_isaelem
+#define vtbl_mglob     perl_vtbl_mglob
+#define vtbl_pack      perl_vtbl_pack
+#define vtbl_packelem  perl_vtbl_packelem
+#define vtbl_sig       perl_vtbl_sig
+#define vtbl_sigelem   perl_vtbl_sigelem
+#define vtbl_substr    perl_vtbl_substr
+#define vtbl_sv                perl_vtbl_sv
+#define vtbl_taint     perl_vtbl_taint
+#define vtbl_uvar      perl_vtbl_uvar
+#define vtbl_vec       perl_vtbl_vec
+#define warn_nl                perl_warn_nl
+#define warn_nosemi    perl_warn_nosemi
+#define warn_reserved  perl_warn_reserved
+#define watchaddr      perl_watchaddr
+#define watchok                perl_watchok
+#define yychar         perl_yychar
+#define yycheck                perl_yycheck
+#define yydebug                perl_yydebug
+#define yydefred       perl_yydefred
+#define yydgoto                perl_yydgoto
+#define yyerrflag      perl_yyerrflag
+#define yygindex       perl_yygindex
+#define yylen          perl_yylen
+#define yylhs          perl_yylhs
+#define yylval         perl_yylval
+#define yyname         perl_yyname
+#define yynerrs                perl_yynerrs
+#define yyrindex       perl_yyrindex
+#define yyrule         perl_yyrule
+#define yysindex       perl_yysindex
+#define yytable                perl_yytable
+#define yyval          perl_yyval
+#define append_elem    perl_append_elem
+#define append_list    perl_append_list
+#define apply          perl_apply
+#define av_clear       perl_av_clear
+#define av_fake                perl_av_fake
+#define av_fetch       perl_av_fetch
+#define av_fill                perl_av_fill
+#define av_free                perl_av_free
+#define av_len         perl_av_len
+#define av_make                perl_av_make
+#define av_pop         perl_av_pop
+#define av_popnulls    perl_av_popnulls
+#define av_push                perl_av_push
+#define av_shift       perl_av_shift
+#define av_store       perl_av_store
+#define av_undef       perl_av_undef
+#define av_unshift     perl_av_unshift
+#define bind_match     perl_bind_match
+#define block_head     perl_block_head
+#define calllist       perl_calllist
+#define cando          perl_cando
+#define check_uni      perl_check_uni
+#define checkcomma     perl_checkcomma
+#define ck_aelem       perl_ck_aelem
+#define ck_chop                perl_ck_chop
+#define ck_concat      perl_ck_concat
+#define ck_eof         perl_ck_eof
+#define ck_eval                perl_ck_eval
+#define ck_exec                perl_ck_exec
+#define ck_formline    perl_ck_formline
+#define ck_ftst                perl_ck_ftst
+#define ck_fun         perl_ck_fun
+#define ck_glob                perl_ck_glob
+#define ck_grep                perl_ck_grep
+#define ck_gvconst     perl_ck_gvconst
+#define ck_index       perl_ck_index
+#define ck_lengthconst perl_ck_lengthconst
+#define ck_lfun                perl_ck_lfun
+#define ck_listiob     perl_ck_listiob
+#define ck_match       perl_ck_match
+#define ck_null                perl_ck_null
+#define ck_repeat      perl_ck_repeat
+#define ck_retarget    perl_ck_retarget
+#define ck_rvconst     perl_ck_rvconst
+#define ck_select      perl_ck_select
+#define ck_shift       perl_ck_shift
+#define ck_sort                perl_ck_sort
+#define ck_split       perl_ck_split
+#define ck_subr                perl_ck_subr
+#define ck_trunc       perl_ck_trunc
+#define convert                perl_convert
+#define cpy7bit                perl_cpy7bit
+#define cpytill                perl_cpytill
+#define croak          perl_croak
+#define cv_clear       perl_cv_clear
+#define cxinc          perl_cxinc
+#define deb            perl_deb
+#define deb_growlevel  perl_deb_growlevel
+#define debop          perl_debop
+#define debstack       perl_debstack
+#define debstackptrs   perl_debstackptrs
+#define die            perl_die
+#define die_where      perl_die_where
+#define do_aexec       perl_do_aexec
+#define do_chop                perl_do_chop
+#define do_close       perl_do_close
+#define do_ctl         perl_do_ctl
+#define do_eof         perl_do_eof
+#define do_exec                perl_do_exec
+#define do_execfree    perl_do_execfree
+#define do_ipcctl      perl_do_ipcctl
+#define do_ipcget      perl_do_ipcget
+#define do_join                perl_do_join
+#define do_kv          perl_do_kv
+#define do_msgrcv      perl_do_msgrcv
+#define do_msgsnd      perl_do_msgsnd
+#define do_open                perl_do_open
+#define do_pipe                perl_do_pipe
+#define do_print       perl_do_print
+#define do_readline    perl_do_readline
+#define do_seek                perl_do_seek
+#define do_semop       perl_do_semop
+#define do_shmio       perl_do_shmio
+#define do_sprintf     perl_do_sprintf
+#define do_tell                perl_do_tell
+#define do_trans       perl_do_trans
+#define do_vecset      perl_do_vecset
+#define do_vop         perl_do_vop
+#define doeval         perl_doeval
+#define dofindlabel    perl_dofindlabel
+#define dopoptoeval    perl_dopoptoeval
+#define dump_all       perl_dump_all
+#define dump_eval      perl_dump_eval
+#define dump_gv                perl_dump_gv
+#define dump_op                perl_dump_op
+#define dump_packsubs  perl_dump_packsubs
+#define dump_pm                perl_dump_pm
+#define dump_sub       perl_dump_sub
+#define fbm_compile    perl_fbm_compile
+#define fbm_instr      perl_fbm_instr
+#define fetch_gv       perl_fetch_gv
+#define fetch_io       perl_fetch_io
+#define fetch_stash    perl_fetch_stash
+#define fold_constants perl_fold_constants
+#define force_ident    perl_force_ident
+#define force_next     perl_force_next
+#define force_word     perl_force_word
+#define free_tmps      perl_free_tmps
+#define gen_constant_list      perl_gen_constant_list
+#define getgimme       perl_getgimme
+#define gp_free                perl_gp_free
+#define gp_ref         perl_gp_ref
+#define gv_AVadd       perl_gv_AVadd
+#define gv_HVadd       perl_gv_HVadd
+#define gv_check       perl_gv_check
+#define gv_efullname   perl_gv_efullname
+#define gv_fetchfile   perl_gv_fetchfile
+#define gv_fetchmeth   perl_gv_fetchmeth
+#define gv_fetchmethod perl_gv_fetchmethod
+#define gv_fetchpv     perl_gv_fetchpv
+#define gv_fullname    perl_gv_fullname
+#define gv_init                perl_gv_init
+#define he_delayfree   perl_he_delayfree
+#define he_free                perl_he_free
+#define hoistmust      perl_hoistmust
+#define hv_clear       perl_hv_clear
+#define hv_delete      perl_hv_delete
+#define hv_fetch       perl_hv_fetch
+#define hv_free                perl_hv_free
+#define hv_iterinit    perl_hv_iterinit
+#define hv_iterkey     perl_hv_iterkey
+#define hv_iternext    perl_hv_iternext
+#define hv_iterval     perl_hv_iterval
+#define hv_magic       perl_hv_magic
+#define hv_store       perl_hv_store
+#define hv_undef       perl_hv_undef
+#define ibcmp          perl_ibcmp
+#define ingroup                perl_ingroup
+#define instr          perl_instr
+#define intuit_more    perl_intuit_more
+#define invert         perl_invert
+#define jmaybe         perl_jmaybe
+#define keyword                perl_keyword
+#define leave_scope    perl_leave_scope
+#define lex_end                perl_lex_end
+#define lex_start      perl_lex_start
+#define linklist       perl_linklist
+#define list           perl_list
+#define listkids       perl_listkids
+#define localize       perl_localize
+#define looks_like_number      perl_looks_like_number
+#define magic_clearpack        perl_magic_clearpack
+#define magic_get      perl_magic_get
+#define magic_getarylen        perl_magic_getarylen
+#define magic_getglob  perl_magic_getglob
+#define magic_getpack  perl_magic_getpack
+#define magic_gettaint perl_magic_gettaint
+#define magic_getuvar  perl_magic_getuvar
+#define magic_len      perl_magic_len
+#define magic_nextpack perl_magic_nextpack
+#define magic_set      perl_magic_set
+#define magic_setarylen        perl_magic_setarylen
+#define magic_setbm    perl_magic_setbm
+#define magic_setdbline        perl_magic_setdbline
+#define magic_setenv   perl_magic_setenv
+#define magic_setglob  perl_magic_setglob
+#define magic_setisa   perl_magic_setisa
+#define magic_setmglob perl_magic_setmglob
+#define magic_setpack  perl_magic_setpack
+#define magic_setsig   perl_magic_setsig
+#define magic_setsubstr        perl_magic_setsubstr
+#define magic_settaint perl_magic_settaint
+#define magic_setuvar  perl_magic_setuvar
+#define magic_setvec   perl_magic_setvec
+#define magicname      perl_magicname
+#define mess           perl_mess
+#define mg_clear       perl_mg_clear
+#define mg_copy                perl_mg_copy
+#define mg_find                perl_mg_find
+#define mg_free                perl_mg_free
+#define mg_get         perl_mg_get
+#define mg_len         perl_mg_len
+#define mg_magical     perl_mg_magical
+#define mg_set         perl_mg_set
+#define mod            perl_mod
+#define modkids                perl_modkids
+#define moreswitches   perl_moreswitches
+#define my             perl_my
+#define my_exit                perl_my_exit
+#define my_lstat       perl_my_lstat
+#define my_pclose      perl_my_pclose
+#define my_popen       perl_my_popen
+#define my_setenv      perl_my_setenv
+#define my_stat                perl_my_stat
+#define my_unexec      perl_my_unexec
+#define newANONHASH    perl_newANONHASH
+#define newANONLIST    perl_newANONLIST
+#define newASSIGNOP    perl_newASSIGNOP
+#define newAV          perl_newAV
+#define newAVREF       perl_newAVREF
+#define newBINOP       perl_newBINOP
+#define newCONDOP      perl_newCONDOP
+#define newCVOP                perl_newCVOP
+#define newCVREF       perl_newCVREF
+#define newFORM                perl_newFORM
+#define newFOROP       perl_newFOROP
+#define newGVOP                perl_newGVOP
+#define newGVREF       perl_newGVREF
+#define newGVgen       perl_newGVgen
+#define newHV          perl_newHV
+#define newHVREF       perl_newHVREF
+#define newIO          perl_newIO
+#define newLISTOP      perl_newLISTOP
+#define newLOGOP       perl_newLOGOP
+#define newLOOPEX      perl_newLOOPEX
+#define newLOOPOP      perl_newLOOPOP
+#define newMETHOD      perl_newMETHOD
+#define newNULLLIST    perl_newNULLLIST
+#define newOP          perl_newOP
+#define newPMOP                perl_newPMOP
+#define newPVOP                perl_newPVOP
+#define newRANGE       perl_newRANGE
+#define newSLICEOP     perl_newSLICEOP
+#define newSTATEOP     perl_newSTATEOP
+#define newSUB         perl_newSUB
+#define newSV          perl_newSV
+#define newSVOP                perl_newSVOP
+#define newSVREF       perl_newSVREF
+#define newSViv                perl_newSViv
+#define newSVnv                perl_newSVnv
+#define newSVpv                perl_newSVpv
+#define newSVsv                perl_newSVsv
+#define newUNOP                perl_newUNOP
+#define newWHILEOP     perl_newWHILEOP
+#define newXSUB                perl_newXSUB
+#define nextargv       perl_nextargv
+#define ninstr         perl_ninstr
+#define no_fh_allowed  perl_no_fh_allowed
+#define no_op          perl_no_op
+#define nsavestr       perl_nsavestr
+#define oopsAV         perl_oopsAV
+#define oopsCV         perl_oopsCV
+#define oopsHV         perl_oopsHV
+#define op_free                perl_op_free
+#define package                perl_package
+#define pad_alloc      perl_pad_alloc
+#define pad_allocmy    perl_pad_allocmy
+#define pad_findmy     perl_pad_findmy
+#define pad_free       perl_pad_free
+#define pad_leavemy    perl_pad_leavemy
+#define pad_reset      perl_pad_reset
+#define pad_sv         perl_pad_sv
+#define pad_swipe      perl_pad_swipe
+#define peep           perl_peep
+#define pidgone                perl_pidgone
+#define pmruntime      perl_pmruntime
+#define pmtrans                perl_pmtrans
+#define pop_return     perl_pop_return
+#define pop_scope      perl_pop_scope
+#define pp_aassign     perl_pp_aassign
+#define pp_accept      perl_pp_accept
+#define pp_add         perl_pp_add
+#define pp_aelem       perl_pp_aelem
+#define pp_aelemfast   perl_pp_aelemfast
+#define pp_alarm       perl_pp_alarm
+#define pp_and         perl_pp_and
+#define pp_andassign   perl_pp_andassign
+#define pp_anonhash    perl_pp_anonhash
+#define pp_anonlist    perl_pp_anonlist
+#define pp_aslice      perl_pp_aslice
+#define pp_atan2       perl_pp_atan2
+#define pp_av2arylen   perl_pp_av2arylen
+#define pp_backtick    perl_pp_backtick
+#define pp_bind                perl_pp_bind
+#define pp_binmode     perl_pp_binmode
+#define pp_bit_and     perl_pp_bit_and
+#define pp_bit_or      perl_pp_bit_or
+#define pp_bless       perl_pp_bless
+#define pp_caller      perl_pp_caller
+#define pp_chdir       perl_pp_chdir
+#define pp_chmod       perl_pp_chmod
+#define pp_chop                perl_pp_chop
+#define pp_chown       perl_pp_chown
+#define pp_chroot      perl_pp_chroot
+#define pp_close       perl_pp_close
+#define pp_closedir    perl_pp_closedir
+#define pp_complement  perl_pp_complement
+#define pp_concat      perl_pp_concat
+#define pp_cond_expr   perl_pp_cond_expr
+#define pp_connect     perl_pp_connect
+#define pp_const       perl_pp_const
+#define pp_cos         perl_pp_cos
+#define pp_crypt       perl_pp_crypt
+#define pp_cswitch     perl_pp_cswitch
+#define pp_dbmclose    perl_pp_dbmclose
+#define pp_dbmopen     perl_pp_dbmopen
+#define pp_dbstate     perl_pp_dbstate
+#define pp_defined     perl_pp_defined
+#define pp_delete      perl_pp_delete
+#define pp_die         perl_pp_die
+#define pp_divide      perl_pp_divide
+#define pp_dofile      perl_pp_dofile
+#define pp_done                perl_pp_done
+#define pp_dump                perl_pp_dump
+#define pp_each                perl_pp_each
+#define pp_egrent      perl_pp_egrent
+#define pp_ehostent    perl_pp_ehostent
+#define pp_enetent     perl_pp_enetent
+#define pp_enter       perl_pp_enter
+#define pp_entereval   perl_pp_entereval
+#define pp_enteriter   perl_pp_enteriter
+#define pp_enterloop   perl_pp_enterloop
+#define pp_entersubr   perl_pp_entersubr
+#define pp_entertry    perl_pp_entertry
+#define pp_enterwrite  perl_pp_enterwrite
+#define pp_eof         perl_pp_eof
+#define pp_eprotoent   perl_pp_eprotoent
+#define pp_epwent      perl_pp_epwent
+#define pp_eq          perl_pp_eq
+#define pp_eservent    perl_pp_eservent
+#define pp_evalonce    perl_pp_evalonce
+#define pp_exec                perl_pp_exec
+#define pp_exit                perl_pp_exit
+#define pp_exp         perl_pp_exp
+#define pp_fcntl       perl_pp_fcntl
+#define pp_fileno      perl_pp_fileno
+#define pp_flip                perl_pp_flip
+#define pp_flock       perl_pp_flock
+#define pp_flop                perl_pp_flop
+#define pp_fork                perl_pp_fork
+#define pp_formline    perl_pp_formline
+#define pp_ftatime     perl_pp_ftatime
+#define pp_ftbinary    perl_pp_ftbinary
+#define pp_ftblk       perl_pp_ftblk
+#define pp_ftchr       perl_pp_ftchr
+#define pp_ftctime     perl_pp_ftctime
+#define pp_ftdir       perl_pp_ftdir
+#define pp_fteexec     perl_pp_fteexec
+#define pp_fteowned    perl_pp_fteowned
+#define pp_fteread     perl_pp_fteread
+#define pp_ftewrite    perl_pp_ftewrite
+#define pp_ftfile      perl_pp_ftfile
+#define pp_ftis                perl_pp_ftis
+#define pp_ftlink      perl_pp_ftlink
+#define pp_ftmtime     perl_pp_ftmtime
+#define pp_ftpipe      perl_pp_ftpipe
+#define pp_ftrexec     perl_pp_ftrexec
+#define pp_ftrowned    perl_pp_ftrowned
+#define pp_ftrread     perl_pp_ftrread
+#define pp_ftrwrite    perl_pp_ftrwrite
+#define pp_ftsgid      perl_pp_ftsgid
+#define pp_ftsize      perl_pp_ftsize
+#define pp_ftsock      perl_pp_ftsock
+#define pp_ftsuid      perl_pp_ftsuid
+#define pp_ftsvtx      perl_pp_ftsvtx
+#define pp_fttext      perl_pp_fttext
+#define pp_fttty       perl_pp_fttty
+#define pp_ftzero      perl_pp_ftzero
+#define pp_ge          perl_pp_ge
+#define pp_getc                perl_pp_getc
+#define pp_getlogin    perl_pp_getlogin
+#define pp_getpeername perl_pp_getpeername
+#define pp_getpgrp     perl_pp_getpgrp
+#define pp_getppid     perl_pp_getppid
+#define pp_getpriority perl_pp_getpriority
+#define pp_getsockname perl_pp_getsockname
+#define pp_ggrent      perl_pp_ggrent
+#define pp_ggrgid      perl_pp_ggrgid
+#define pp_ggrnam      perl_pp_ggrnam
+#define pp_ghbyaddr    perl_pp_ghbyaddr
+#define pp_ghbyname    perl_pp_ghbyname
+#define pp_ghostent    perl_pp_ghostent
+#define pp_glob                perl_pp_glob
+#define pp_gmtime      perl_pp_gmtime
+#define pp_gnbyaddr    perl_pp_gnbyaddr
+#define pp_gnbyname    perl_pp_gnbyname
+#define pp_gnetent     perl_pp_gnetent
+#define pp_goto                perl_pp_goto
+#define pp_gpbyname    perl_pp_gpbyname
+#define pp_gpbynumber  perl_pp_gpbynumber
+#define pp_gprotoent   perl_pp_gprotoent
+#define pp_gpwent      perl_pp_gpwent
+#define pp_gpwnam      perl_pp_gpwnam
+#define pp_gpwuid      perl_pp_gpwuid
+#define pp_grepstart   perl_pp_grepstart
+#define pp_grepwhile   perl_pp_grepwhile
+#define pp_gsbyname    perl_pp_gsbyname
+#define pp_gsbyport    perl_pp_gsbyport
+#define pp_gservent    perl_pp_gservent
+#define pp_gsockopt    perl_pp_gsockopt
+#define pp_gt          perl_pp_gt
+#define pp_gv          perl_pp_gv
+#define pp_gvsv                perl_pp_gvsv
+#define pp_helem       perl_pp_helem
+#define pp_hex         perl_pp_hex
+#define pp_hslice      perl_pp_hslice
+#define pp_index       perl_pp_index
+#define pp_indread     perl_pp_indread
+#define pp_int         perl_pp_int
+#define pp_intadd      perl_pp_intadd
+#define pp_interp      perl_pp_interp
+#define pp_ioctl       perl_pp_ioctl
+#define pp_iter                perl_pp_iter
+#define pp_join                perl_pp_join
+#define pp_keys                perl_pp_keys
+#define pp_kill                perl_pp_kill
+#define pp_last                perl_pp_last
+#define pp_lc          perl_pp_lc
+#define pp_lcfirst     perl_pp_lcfirst
+#define pp_le          perl_pp_le
+#define pp_leave       perl_pp_leave
+#define pp_leaveeval   perl_pp_leaveeval
+#define pp_leaveloop   perl_pp_leaveloop
+#define pp_leavesubr   perl_pp_leavesubr
+#define pp_leavetry    perl_pp_leavetry
+#define pp_leavewrite  perl_pp_leavewrite
+#define pp_left_shift  perl_pp_left_shift
+#define pp_length      perl_pp_length
+#define pp_lineseq     perl_pp_lineseq
+#define pp_link                perl_pp_link
+#define pp_list                perl_pp_list
+#define pp_listen      perl_pp_listen
+#define pp_localtime   perl_pp_localtime
+#define pp_log         perl_pp_log
+#define pp_lslice      perl_pp_lslice
+#define pp_lstat       perl_pp_lstat
+#define pp_lt          perl_pp_lt
+#define pp_match       perl_pp_match
+#define pp_method      perl_pp_method
+#define pp_mkdir       perl_pp_mkdir
+#define pp_modulo      perl_pp_modulo
+#define pp_msgctl      perl_pp_msgctl
+#define pp_msgget      perl_pp_msgget
+#define pp_msgrcv      perl_pp_msgrcv
+#define pp_msgsnd      perl_pp_msgsnd
+#define pp_multiply    perl_pp_multiply
+#define pp_ncmp                perl_pp_ncmp
+#define pp_ne          perl_pp_ne
+#define pp_negate      perl_pp_negate
+#define pp_next                perl_pp_next
+#define pp_nextstate   perl_pp_nextstate
+#define pp_not         perl_pp_not
+#define pp_nswitch     perl_pp_nswitch
+#define pp_null                perl_pp_null
+#define pp_oct         perl_pp_oct
+#define pp_open                perl_pp_open
+#define pp_open_dir    perl_pp_open_dir
+#define pp_or          perl_pp_or
+#define pp_orassign    perl_pp_orassign
+#define pp_ord         perl_pp_ord
+#define pp_pack                perl_pp_pack
+#define pp_padav       perl_pp_padav
+#define pp_padhv       perl_pp_padhv
+#define pp_padsv       perl_pp_padsv
+#define pp_pipe_op     perl_pp_pipe_op
+#define pp_pop         perl_pp_pop
+#define pp_postdec     perl_pp_postdec
+#define pp_postinc     perl_pp_postinc
+#define pp_pow         perl_pp_pow
+#define pp_predec      perl_pp_predec
+#define pp_preinc      perl_pp_preinc
+#define pp_print       perl_pp_print
+#define pp_prtf                perl_pp_prtf
+#define pp_push                perl_pp_push
+#define pp_pushmark    perl_pp_pushmark
+#define pp_pushre      perl_pp_pushre
+#define pp_rand                perl_pp_rand
+#define pp_range       perl_pp_range
+#define pp_rcatline    perl_pp_rcatline
+#define pp_read                perl_pp_read
+#define pp_readdir     perl_pp_readdir
+#define pp_readline    perl_pp_readline
+#define pp_readlink    perl_pp_readlink
+#define pp_recv                perl_pp_recv
+#define pp_redo                perl_pp_redo
+#define pp_ref         perl_pp_ref
+#define pp_refgen      perl_pp_refgen
+#define pp_regcmaybe   perl_pp_regcmaybe
+#define pp_regcomp     perl_pp_regcomp
+#define pp_rename      perl_pp_rename
+#define pp_repeat      perl_pp_repeat
+#define pp_require     perl_pp_require
+#define pp_reset       perl_pp_reset
+#define pp_return      perl_pp_return
+#define pp_reverse     perl_pp_reverse
+#define pp_rewinddir   perl_pp_rewinddir
+#define pp_right_shift perl_pp_right_shift
+#define pp_rindex      perl_pp_rindex
+#define pp_rmdir       perl_pp_rmdir
+#define pp_rv2av       perl_pp_rv2av
+#define pp_rv2cv       perl_pp_rv2cv
+#define pp_rv2gv       perl_pp_rv2gv
+#define pp_rv2hv       perl_pp_rv2hv
+#define pp_rv2sv       perl_pp_rv2sv
+#define pp_sassign     perl_pp_sassign
+#define pp_scalar      perl_pp_scalar
+#define pp_schop       perl_pp_schop
+#define pp_scmp                perl_pp_scmp
+#define pp_scope       perl_pp_scope
+#define pp_seek                perl_pp_seek
+#define pp_seekdir     perl_pp_seekdir
+#define pp_select      perl_pp_select
+#define pp_semctl      perl_pp_semctl
+#define pp_semget      perl_pp_semget
+#define pp_semop       perl_pp_semop
+#define pp_send                perl_pp_send
+#define pp_seq         perl_pp_seq
+#define pp_setpgrp     perl_pp_setpgrp
+#define pp_setpriority perl_pp_setpriority
+#define pp_sge         perl_pp_sge
+#define pp_sgrent      perl_pp_sgrent
+#define pp_sgt         perl_pp_sgt
+#define pp_shift       perl_pp_shift
+#define pp_shmctl      perl_pp_shmctl
+#define pp_shmget      perl_pp_shmget
+#define pp_shmread     perl_pp_shmread
+#define pp_shmwrite    perl_pp_shmwrite
+#define pp_shostent    perl_pp_shostent
+#define pp_shutdown    perl_pp_shutdown
+#define pp_sin         perl_pp_sin
+#define pp_sle         perl_pp_sle
+#define pp_sleep       perl_pp_sleep
+#define pp_slt         perl_pp_slt
+#define pp_sne         perl_pp_sne
+#define pp_snetent     perl_pp_snetent
+#define pp_socket      perl_pp_socket
+#define pp_sockpair    perl_pp_sockpair
+#define pp_sort                perl_pp_sort
+#define pp_splice      perl_pp_splice
+#define pp_split       perl_pp_split
+#define pp_sprintf     perl_pp_sprintf
+#define pp_sprotoent   perl_pp_sprotoent
+#define pp_spwent      perl_pp_spwent
+#define pp_sqrt                perl_pp_sqrt
+#define pp_srand       perl_pp_srand
+#define pp_sselect     perl_pp_sselect
+#define pp_sservent    perl_pp_sservent
+#define pp_ssockopt    perl_pp_ssockopt
+#define pp_stat                perl_pp_stat
+#define pp_stub                perl_pp_stub
+#define pp_study       perl_pp_study
+#define pp_subst       perl_pp_subst
+#define pp_substcont   perl_pp_substcont
+#define pp_substr      perl_pp_substr
+#define pp_subtract    perl_pp_subtract
+#define pp_sv2len      perl_pp_sv2len
+#define pp_symlink     perl_pp_symlink
+#define pp_syscall     perl_pp_syscall
+#define pp_sysread     perl_pp_sysread
+#define pp_system      perl_pp_system
+#define pp_syswrite    perl_pp_syswrite
+#define pp_tell                perl_pp_tell
+#define pp_telldir     perl_pp_telldir
+#define pp_tie         perl_pp_tie
+#define pp_time                perl_pp_time
+#define pp_tms         perl_pp_tms
+#define pp_trans       perl_pp_trans
+#define pp_truncate    perl_pp_truncate
+#define pp_uc          perl_pp_uc
+#define pp_ucfirst     perl_pp_ucfirst
+#define pp_umask       perl_pp_umask
+#define pp_undef       perl_pp_undef
+#define pp_unlink      perl_pp_unlink
+#define pp_unpack      perl_pp_unpack
+#define pp_unshift     perl_pp_unshift
+#define pp_unstack     perl_pp_unstack
+#define pp_untie       perl_pp_untie
+#define pp_utime       perl_pp_utime
+#define pp_values      perl_pp_values
+#define pp_vec         perl_pp_vec
+#define pp_wait                perl_pp_wait
+#define pp_waitpid     perl_pp_waitpid
+#define pp_wantarray   perl_pp_wantarray
+#define pp_warn                perl_pp_warn
+#define pp_xor         perl_pp_xor
+#define prepend_elem   perl_prepend_elem
+#define push_return    perl_push_return
+#define push_scope     perl_push_scope
+#define q              perl_q
+#define ref            perl_ref
+#define refkids                perl_refkids
+#define regcomp                perl_regcomp
+#define regdump                perl_regdump
+#define regexec                perl_regexec
+#define regfree                perl_regfree
+#define regnext                perl_regnext
+#define regprop                perl_regprop
+#define repeatcpy      perl_repeatcpy
+#define rninstr                perl_rninstr
+#define run            perl_run
+#define save_I32       perl_save_I32
+#define save_aptr      perl_save_aptr
+#define save_ary       perl_save_ary
+#define save_clearsv   perl_save_clearsv
+#define save_delete    perl_save_delete
+#define save_freeop    perl_save_freeop
+#define save_freepv    perl_save_freepv
+#define save_freesv    perl_save_freesv
+#define save_hash      perl_save_hash
+#define save_hptr      perl_save_hptr
+#define save_int       perl_save_int
+#define save_item      perl_save_item
+#define save_list      perl_save_list
+#define save_nogv      perl_save_nogv
+#define save_scalar    perl_save_scalar
+#define save_sptr      perl_save_sptr
+#define save_svref     perl_save_svref
+#define savestack_grow perl_savestack_grow
+#define savestr                perl_savestr
+#define sawparens      perl_sawparens
+#define scalar         perl_scalar
+#define scalarkids     perl_scalarkids
+#define scalarseq      perl_scalarseq
+#define scalarvoid     perl_scalarvoid
+#define scan_const     perl_scan_const
+#define scan_formline  perl_scan_formline
+#define scan_heredoc   perl_scan_heredoc
+#define scan_hex       perl_scan_hex
+#define scan_ident     perl_scan_ident
+#define scan_inputsymbol       perl_scan_inputsymbol
+#define scan_num       perl_scan_num
+#define scan_oct       perl_scan_oct
+#define scan_pat       perl_scan_pat
+#define scan_prefix    perl_scan_prefix
+#define scan_str       perl_scan_str
+#define scan_subst     perl_scan_subst
+#define scan_trans     perl_scan_trans
+#define scan_word      perl_scan_word
+#define scope          perl_scope
+#define screaminstr    perl_screaminstr
+#define setenv_getix   perl_setenv_getix
+#define skipspace      perl_skipspace
+#define start_subparse perl_start_subparse
+#define sublex_done    perl_sublex_done
+#define sublex_start   perl_sublex_start
+#define sv_2bool       perl_sv_2bool
+#define sv_2cv         perl_sv_2cv
+#define sv_2iv         perl_sv_2iv
+#define sv_2mortal     perl_sv_2mortal
+#define sv_2nv         perl_sv_2nv
+#define sv_2pv         perl_sv_2pv
+#define sv_backoff     perl_sv_backoff
+#define sv_catpv       perl_sv_catpv
+#define sv_catpvn      perl_sv_catpvn
+#define sv_catsv       perl_sv_catsv
+#define sv_chop                perl_sv_chop
+#define sv_clean_all   perl_sv_clean_all
+#define sv_clean_magic perl_sv_clean_magic
+#define sv_clean_refs  perl_sv_clean_refs
+#define sv_clear       perl_sv_clear
+#define sv_cmp         perl_sv_cmp
+#define sv_dec         perl_sv_dec
+#define sv_dump                perl_sv_dump
+#define sv_eq          perl_sv_eq
+#define sv_free                perl_sv_free
+#define sv_gets                perl_sv_gets
+#define sv_grow                perl_sv_grow
+#define sv_inc         perl_sv_inc
+#define sv_insert      perl_sv_insert
+#define sv_isa         perl_sv_isa
+#define sv_len         perl_sv_len
+#define sv_magic       perl_sv_magic
+#define sv_mortalcopy  perl_sv_mortalcopy
+#define sv_newmortal   perl_sv_newmortal
+#define sv_peek                perl_sv_peek
+#define sv_ref         perl_sv_ref
+#define sv_replace     perl_sv_replace
+#define sv_report_used perl_sv_report_used
+#define sv_reset       perl_sv_reset
+#define sv_setiv       perl_sv_setiv
+#define sv_setnv       perl_sv_setnv
+#define sv_setptrobj   perl_sv_setptrobj
+#define sv_setpv       perl_sv_setpv
+#define sv_setpvn      perl_sv_setpvn
+#define sv_setsv       perl_sv_setsv
+#define sv_unmagic     perl_sv_unmagic
+#define sv_upgrade     perl_sv_upgrade
+#define sv_usepvn      perl_sv_usepvn
+#define taint_env      perl_taint_env
+#define taint_not      perl_taint_not
+#define taint_proper   perl_taint_proper
+#define too_few_arguments      perl_too_few_arguments
+#define too_many_arguments     perl_too_many_arguments
+#define wait4pid       perl_wait4pid
+#define warn           perl_warn
+#define watch          perl_watch
+#define whichsig       perl_whichsig
+#define xiv_root       perl_xiv_root
+#define xnv_root       perl_xnv_root
+#define xpv_root       perl_xpv_root
+#define xrv_root       perl_xrv_root
+#define yyerror                perl_yyerror
+#define yyerror                perl_yyerror
+#define yylex          perl_yylex
+#define yyparse                perl_yyparse
+#define yywarn         perl_yywarn
 
-#endif /* EMBEDDED */
+#endif /* EMBED */
 
-/* Put interpreter specific variables into a struct? */
+/* Put interpreter specific symbols into a struct? */
 
 #ifdef MULTIPLICITY
 
 #define forkprocess    (curinterp->Iforkprocess)
 #define formfeed       (curinterp->Iformfeed)
 #define formtarget     (curinterp->Iformtarget)
-#define freestrroot    (curinterp->Ifreestrroot)
 #define gensym         (curinterp->Igensym)
 #define in_eval                (curinterp->Iin_eval)
 #define incgv          (curinterp->Iincgv)
 #define statusvalue    (curinterp->Istatusvalue)
 #define stdingv                (curinterp->Istdingv)
 #define strchop                (curinterp->Istrchop)
+#define sv_count       (curinterp->Isv_count)
+#define sv_rvcount     (curinterp->Isv_rvcount)
+#define sv_root                (curinterp->Isv_root)
+#define sv_arenaroot   (curinterp->Isv_arenaroot)
 #define tainted                (curinterp->Itainted)
 #define tainting       (curinterp->Itainting)
 #define tmps_floor     (curinterp->Itmps_floor)
 #define toptarget      (curinterp->Itoptarget)
 #define unsafe         (curinterp->Iunsafe)
 
-#else  /* not multiple, so translate interpreter variables the other way... */
+#else  /* not multiple, so translate interpreter symbols the other way... */
 
 #define IArgv          Argv
 #define ICmd           Cmd
 #define Iforkprocess   forkprocess
 #define Iformfeed      formfeed
 #define Iformtarget    formtarget
-#define Ifreestrroot   freestrroot
 #define Igensym                gensym
 #define Iin_eval       in_eval
 #define Iincgv         incgv
 #define Istatusvalue   statusvalue
 #define Istdingv       stdingv
 #define Istrchop       strchop
+#define Isv_count      sv_count
+#define Isv_rvcount    sv_rvcount
+#define Isv_root       sv_root
+#define Isv_arenaroot  sv_arenaroot
 #define Itainted       tainted
 #define Itainting      tainting
 #define Itmps_floor    tmps_floor
 #define Itoptarget     toptarget
 #define Iunsafe                unsafe
 
-#endif /* MULTIPLE_INTERPRETERS */
+#endif /* MULTIPLICITY */
index d78bffb..2ba9fe2 100755 (executable)
@@ -1,7 +1,7 @@
 #!/bin/sh
 
 cat <<'END' >embed.h
-/* This file is derived from global.var and interp.var */
+/* This file is derived from global.sym and interp.sym */
 
 /* (Doing namespace management portably in C is really gross.) */
 
@@ -10,24 +10,24 @@ cat <<'END' >embed.h
 /* globals we need to hide from the world */
 END
 
-sed <global.var >>embed.h                                              \
+sed <global.sym >>embed.h                                              \
        -e 's/[         ]*#.*//'                                        \
        -e '/^[         ]*$/d'                                          \
-       -e 's/\(.*\)/#define \1         PERL\1/'                        \
+       -e 's/\(.*\)/#define \1         perl_\1/'                       \
        -e 's/\(................        \)      /\1/'
 
 cat <<'END' >> embed.h
 
-#endif /* EMBEDDED */
+#endif /* EMBED */
 
-/* Put interpreter specific variables into a struct? */
+/* Put interpreter specific symbols into a struct? */
 
 #ifdef MULTIPLICITY
 
 END
 
 
-sed <interp.var >>embed.h                                              \
+sed <interp.sym >>embed.h                                              \
        -e 's/[         ]*#.*//'                                        \
        -e '/^[         ]*$/d'                                          \
        -e 's/\(.*\)/#define \1         (curinterp->I\1)/'              \
@@ -35,11 +35,11 @@ sed <interp.var >>embed.h                                           \
 
 cat <<'END' >> embed.h
 
-#else  /* not multiple, so translate interpreter variables the other way... */
+#else  /* not multiple, so translate interpreter symbols the other way... */
 
 END
 
-sed <interp.var >>embed.h                                              \
+sed <interp.sym >>embed.h                                              \
        -e 's/[         ]*#.*//'                                        \
        -e '/^[         ]*$/d'                                          \
        -e 's/\(.*\)/#define I\1                \1/'                    \
@@ -47,6 +47,6 @@ sed <interp.var >>embed.h                                             \
 
 cat <<'END' >> embed.h
 
-#endif /* MULTIPLE_INTERPRETERS */
+#endif /* MULTIPLICITY */
 END
 
diff --git a/eval.c.save b/eval.c.save
deleted file mode 100644 (file)
index 964bc03..0000000
+++ /dev/null
@@ -1,3048 +0,0 @@
-/* $RCSfile: eval.c,v $$Revision: 4.1 $$Date: 92/08/07 18:20:29 $
- *
- *    Copyright (c) 1991, Larry Wall
- *
- *    You may distribute under the terms of either the GNU General Public
- *    License or the Artistic License, as specified in the README file.
- *
- * $Log:       eval.c,v $
- * Revision 4.1  92/08/07  18:20:29  lwall
- * 
- * Revision 4.0.1.4  92/06/08  13:20:20  lwall
- * patch20: added explicit time_t support
- * patch20: fixed confusion between a *var's real name and its effective name
- * patch20: added Atari ST portability
- * patch20: new warning for use of x with non-numeric right operand
- * patch20: modulus with highest bit in left operand set didn't always work
- * patch20: dbmclose(%array) didn't work
- * patch20: added ... as variant on ..
- * patch20: O_PIPE conflicted with Atari
- * 
- * Revision 4.0.1.3  91/11/05  17:15:21  lwall
- * patch11: prepared for ctype implementations that don't define isascii()
- * patch11: various portability fixes
- * patch11: added sort {} LIST
- * patch11: added eval {}
- * patch11: sysread() in socket was substituting recv()
- * patch11: a last statement outside any block caused occasional core dumps
- * patch11: missing arguments caused core dump in -D8 code
- * patch11: eval 'stuff' now optimized to eval {stuff}
- * 
- * Revision 4.0.1.2  91/06/07  11:07:23  lwall
- * patch4: new copyright notice
- * patch4: length($`), length($&), length($') now optimized to avoid string copy
- * patch4: assignment wasn't correctly de-tainting the assigned variable.
- * patch4: default top-of-form format is now FILEHANDLE_TOP
- * patch4: added $^P variable to control calling of perldb routines
- * patch4: taintchecks could improperly modify parent in vfork()
- * patch4: many, many itty-bitty portability fixes
- * 
- * Revision 4.0.1.1  91/04/11  17:43:48  lwall
- * patch1: fixed failed fork to return undef as documented
- * patch1: reduced maximum branch distance in eval.c
- * 
- * Revision 4.0  91/03/20  01:16:48  lwall
- * 4.0 baseline.
- * 
- */
-
-#include "EXTERN.h"
-#include "perl.h"
-
-extern int (*ppaddr[])();
-extern int mark[];
-
-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
-#include <signal.h>
-#endif
-
-#ifdef I_FCNTL
-#include <fcntl.h>
-#endif
-#ifdef MSDOS
-/* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
-   but fcntl.h is required for O_BINARY */
-#include <fcntl.h>
-#endif
-#ifdef I_SYS_FILE
-#include <sys/file.h>
-#endif
-#ifdef I_VFORK
-#   include <vfork.h>
-#endif
-
-double sin(), cos(), atan2(), pow();
-
-char *getlogin();
-
-int
-eval(arg,gimme,sp)
-register ARG *arg;
-int gimme;
-register int sp;
-{
-    register STR *str;
-    register int anum;
-    register int optype;
-    register STR **st;
-    int maxarg;
-    double value;
-    register char *tmps;
-    char *tmps2;
-    int argflags;
-    int argtype;
-    union argptr argptr;
-    int arglast[8];    /* highest sp for arg--valid only for non-O_LIST args */
-    unsigned long tmpulong;
-    long tmplong;
-    time_t when;
-    STRLEN tmplen;
-    FILE *fp;
-    STR *tmpstr;
-    FCMD *form;
-    STAB *stab;
-    STAB *stab2;
-    STIO *stio;
-    ARRAY *ary;
-    int old_rslen;
-    int old_rschar;
-    VOIDRET (*ihand)();     /* place to save signal during system() */
-    VOIDRET (*qhand)();     /* place to save signal during system() */
-    bool assigning = FALSE;
-    int mymarkbase = savestack->ary_fill;
-
-    if (!arg)
-       goto say_undef;
-    optype = arg->arg_type;
-    maxarg = arg->arg_len;
-    arglast[0] = sp;
-    str = arg->arg_ptr.arg_str;
-    if (sp + maxarg > stack->ary_max)
-       astore(stack, sp + maxarg, Nullstr);
-    st = stack->ary_array;
-
-#ifdef DEBUGGING
-    if (debug) {
-       if (debug & 8) {
-           deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
-       }
-       debname[dlevel] = opname[optype][0];
-       debdelim[dlevel] = ':';
-       if (++dlevel >= dlmax)
-           grow_dlevel();
-    }
-#endif
-
-    if (mark[optype]) {
-       saveint(&markbase);
-       markbase = mymarkbase;
-       saveint(&stack_mark);
-       stack_mark = sp;
-    }
-    for (anum = 1; anum <= maxarg; anum++) {
-       argflags = arg[anum].arg_flags;
-       argtype = arg[anum].arg_type;
-       argptr = arg[anum].arg_ptr;
-      re_eval:
-       switch (argtype) {
-       default:
-           if (!ppaddr[optype] || optype == O_SUBR || optype == O_DBSUBR) {
-               st[++sp] = &str_undef;
-           }
-#ifdef DEBUGGING
-           tmps = "NULL";
-#endif
-           break;
-       case A_EXPR:
-#ifdef DEBUGGING
-           if (debug & 8) {
-               tmps = "EXPR";
-               deb("%d.EXPR =>\n",anum);
-           }
-#endif
-           sp = eval(argptr.arg_arg,
-               (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp);
-           if (sp + (maxarg - anum) > stack->ary_max)
-               astore(stack, sp + (maxarg - anum), Nullstr);
-           st = stack->ary_array;      /* possibly reallocated */
-           break;
-       case A_CMD:
-#ifdef DEBUGGING
-           if (debug & 8) {
-               tmps = "CMD";
-               deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
-           }
-#endif
-           sp = cmd_exec(argptr.arg_cmd, gimme, sp);
-           if (sp + (maxarg - anum) > stack->ary_max)
-               astore(stack, sp + (maxarg - anum), Nullstr);
-           st = stack->ary_array;      /* possibly reallocated */
-           break;
-       case A_LARYSTAB:
-           ++sp;
-           switch (optype) {
-               case O_ITEM2: argtype = 2; break;
-               case O_ITEM3: argtype = 3; break;
-               default:      argtype = anum; break;
-           }
-           str = afetch(stab_array(argptr.arg_stab),
-               arg[argtype].arg_len - arybase, TRUE);
-#ifdef DEBUGGING
-           if (debug & 8) {
-               (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
-                   arg[argtype].arg_len);
-               tmps = buf;
-           }
-#endif
-           goto do_crement;
-       case A_ARYSTAB:
-           switch (optype) {
-               case O_ITEM2: argtype = 2; break;
-               case O_ITEM3: argtype = 3; break;
-               default:      argtype = anum; break;
-           }
-           st[++sp] = afetch(stab_array(argptr.arg_stab),
-               arg[argtype].arg_len - arybase, FALSE);
-#ifdef DEBUGGING
-           if (debug & 8) {
-               (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
-                   arg[argtype].arg_len);
-               tmps = buf;
-           }
-#endif
-           break;
-       case A_STAR:
-           stab = argptr.arg_stab;
-           st[++sp] = (STR*)stab;
-           if (!stab_xarray(stab))
-               aadd(stab);
-           if (!stab_xhash(stab))
-               hadd(stab);
-           if (!stab_io(stab))
-               stab_io(stab) = stio_new();
-#ifdef DEBUGGING
-           if (debug & 8) {
-               (void)sprintf(buf,"STAR *%s -> *%s",
-                   stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
-               tmps = buf;
-           }
-#endif
-           break;
-       case A_LSTAR:
-           str = st[++sp] = (STR*)argptr.arg_stab;
-#ifdef DEBUGGING
-           if (debug & 8) {
-               (void)sprintf(buf,"LSTAR *%s -> *%s",
-               stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
-               tmps = buf;
-           }
-#endif
-           break;
-       case A_STAB:
-           st[++sp] = STAB_STR(argptr.arg_stab);
-#ifdef DEBUGGING
-           if (debug & 8) {
-               (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab));
-               tmps = buf;
-           }
-#endif
-           break;
-       case A_LENSTAB:
-           str_numset(str, (double)STAB_LEN(argptr.arg_stab));
-           st[++sp] = str;
-#ifdef DEBUGGING
-           if (debug & 8) {
-               (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab));
-               tmps = buf;
-           }
-#endif
-           break;
-       case A_LEXPR:
-#ifdef DEBUGGING
-           if (debug & 8) {
-               tmps = "LEXPR";
-               deb("%d.LEXPR =>\n",anum);
-           }
-#endif
-           if (argflags & AF_ARYOK) {
-               sp = eval(argptr.arg_arg, G_ARRAY, sp);
-               if (sp + (maxarg - anum) > stack->ary_max)
-                   astore(stack, sp + (maxarg - anum), Nullstr);
-               st = stack->ary_array;  /* possibly reallocated */
-           }
-           else {
-               sp = eval(argptr.arg_arg, G_SCALAR, sp);
-               st = stack->ary_array;  /* possibly reallocated */
-               str = st[sp];
-               goto do_crement;
-           }
-           break;
-       case A_LVAL:
-#ifdef DEBUGGING
-           if (debug & 8) {
-               (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab));
-               tmps = buf;
-           }
-#endif
-           ++sp;
-           str = STAB_STR(argptr.arg_stab);
-           if (!str)
-               fatal("panic: A_LVAL");
-         do_crement:
-           assigning = TRUE;
-           if (argflags & AF_PRE) {
-               if (argflags & AF_UP)
-                   str_inc(str);
-               else
-                   str_dec(str);
-               STABSET(str);
-               st[sp] = str;
-               str = arg->arg_ptr.arg_str;
-           }
-           else if (argflags & AF_POST) {
-               st[sp] = str_mortal(str);
-               if (argflags & AF_UP)
-                   str_inc(str);
-               else
-                   str_dec(str);
-               STABSET(str);
-               str = arg->arg_ptr.arg_str;
-           }
-           else
-               st[sp] = str;
-           break;
-       case A_LARYLEN:
-           ++sp;
-           stab = argptr.arg_stab;
-           str = stab_array(argptr.arg_stab)->ary_magic;
-           if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
-               str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
-#ifdef DEBUGGING
-           tmps = "LARYLEN";
-#endif
-           if (!str)
-               fatal("panic: A_LEXPR");
-           goto do_crement;
-       case A_ARYLEN:
-           stab = argptr.arg_stab;
-           st[++sp] = stab_array(stab)->ary_magic;
-           str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase));
-#ifdef DEBUGGING
-           tmps = "ARYLEN";
-#endif
-           break;
-       case A_SINGLE:
-           st[++sp] = argptr.arg_str;
-#ifdef DEBUGGING
-           tmps = "SINGLE";
-#endif
-           break;
-       case A_DOUBLE:
-           (void) interp(str,argptr.arg_str,sp);
-           st = stack->ary_array;
-           st[++sp] = str;
-#ifdef DEBUGGING
-           tmps = "DOUBLE";
-#endif
-           break;
-       case A_BACKTICK:
-           tmps = str_get(interp(str,argptr.arg_str,sp));
-           st = stack->ary_array;
-#ifdef TAINT
-           TAINT_PROPER("``");
-#endif
-           fp = mypopen(tmps,"r");
-           str_set(str,"");
-           if (fp) {
-               if (gimme == G_SCALAR) {
-                   while (str_gets(str,fp,str->str_cur) != Nullch)
-                       /*SUPPRESS 530*/
-                       ;
-               }
-               else {
-                   for (;;) {
-                       if (++sp > stack->ary_max) {
-                           astore(stack, sp, Nullstr);
-                           st = stack->ary_array;
-                       }
-                       str = st[sp] = Str_new(56,80);
-                       if (str_gets(str,fp,0) == Nullch) {
-                           sp--;
-                           break;
-                       }
-                       if (str->str_len - str->str_cur > 20) {
-                           str->str_len = str->str_cur+1;
-                           Renew(str->str_ptr, str->str_len, char);
-                       }
-                       str_2mortal(str);
-                   }
-               }
-               statusvalue = mypclose(fp);
-           }
-           else
-               statusvalue = -1;
-
-           if (gimme == G_SCALAR)
-               st[++sp] = str;
-#ifdef DEBUGGING
-           tmps = "BACK";
-#endif
-           break;
-       case A_WANTARRAY:
-           {
-               if (curcsv->wantarray == G_ARRAY)
-                   st[++sp] = &str_yes;
-               else
-                   st[++sp] = &str_no;
-           }
-#ifdef DEBUGGING
-           tmps = "WANTARRAY";
-#endif
-           break;
-       case A_INDREAD:
-           last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
-           old_rschar = rschar;
-           old_rslen = rslen;
-           goto do_read;
-       case A_GLOB:
-           argflags |= AF_POST;        /* enable newline chopping */
-           last_in_stab = argptr.arg_stab;
-           old_rschar = rschar;
-           old_rslen = rslen;
-           rslen = 1;
-#ifdef DOSISH
-           rschar = 0;
-#else
-#ifdef CSH
-           rschar = 0;
-#else
-           rschar = '\n';
-#endif /* !CSH */
-#endif /* !MSDOS */
-           goto do_read;
-       case A_READ:
-           last_in_stab = argptr.arg_stab;
-           old_rschar = rschar;
-           old_rslen = rslen;
-         do_read:
-           if (anum > 1)               /* assign to scalar */
-               gimme = G_SCALAR;       /* force context to scalar */
-           if (gimme == G_ARRAY)
-               str = Str_new(57,0);
-           ++sp;
-           fp = Nullfp;
-           if (stab_io(last_in_stab)) {
-               fp = stab_io(last_in_stab)->ifp;
-               if (!fp) {
-                   if (stab_io(last_in_stab)->flags & IOF_ARGV) {
-                       if (stab_io(last_in_stab)->flags & IOF_START) {
-                           stab_io(last_in_stab)->flags &= ~IOF_START;
-                           stab_io(last_in_stab)->lines = 0;
-                           if (alen(stab_array(last_in_stab)) < 0) {
-                               tmpstr = str_make("-",1); /* assume stdin */
-                               (void)apush(stab_array(last_in_stab), tmpstr);
-                           }
-                       }
-                       fp = nextargv(last_in_stab);
-                       if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
-                           (void)do_close(last_in_stab,FALSE); /* now it does*/
-                           stab_io(last_in_stab)->flags |= IOF_START;
-                       }
-                   }
-                   else if (argtype == A_GLOB) {
-                       (void) interp(str,stab_val(last_in_stab),sp);
-                       st = stack->ary_array;
-                       tmpstr = Str_new(55,0);
-#ifdef DOSISH
-                       str_set(tmpstr, "perlglob ");
-                       str_scat(tmpstr,str);
-                       str_cat(tmpstr," |");
-#else
-#ifdef CSH
-                       str_nset(tmpstr,cshname,cshlen);
-                       str_cat(tmpstr," -cf 'set nonomatch; glob ");
-                       str_scat(tmpstr,str);
-                       str_cat(tmpstr,"'|");
-#else
-                       str_set(tmpstr, "echo ");
-                       str_scat(tmpstr,str);
-                       str_cat(tmpstr,
-                         "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
-#endif /* !CSH */
-#endif /* !MSDOS */
-                       (void)do_open(last_in_stab,tmpstr->str_ptr,
-                         tmpstr->str_cur);
-                       fp = stab_io(last_in_stab)->ifp;
-                       str_free(tmpstr);
-                   }
-               }
-           }
-           if (!fp && dowarn)
-               warn("Read on closed filehandle <%s>",stab_ename(last_in_stab));
-           tmplen = str->str_len;      /* remember if already alloced */
-           if (!tmplen)
-               Str_Grow(str,80);       /* try short-buffering it */
-         keepgoing:
-           if (!fp)
-               st[sp] = &str_undef;
-           else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) {
-               clearerr(fp);
-               if (stab_io(last_in_stab)->flags & IOF_ARGV) {
-                   fp = nextargv(last_in_stab);
-                   if (fp)
-                       goto keepgoing;
-                   (void)do_close(last_in_stab,FALSE);
-                   stab_io(last_in_stab)->flags |= IOF_START;
-               }
-               else if (argflags & AF_POST) {
-                   (void)do_close(last_in_stab,FALSE);
-               }
-               st[sp] = &str_undef;
-               rschar = old_rschar;
-               rslen = old_rslen;
-               if (gimme == G_ARRAY) {
-                   --sp;
-                   str_2mortal(str);
-                   goto array_return;
-               }
-               break;
-           }
-           else {
-               stab_io(last_in_stab)->lines++;
-               st[sp] = str;
-#ifdef TAINT
-               str->str_tainted = 1; /* Anything from the outside world...*/
-#endif
-               if (argflags & AF_POST) {
-                   if (str->str_cur > 0)
-                       str->str_cur--;
-                   if (str->str_ptr[str->str_cur] == rschar)
-                       str->str_ptr[str->str_cur] = '\0';
-                   else
-                       str->str_cur++;
-                   for (tmps = str->str_ptr; *tmps; tmps++)
-                       if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
-                           index("$&*(){}[]'\";\\|?<>~`",*tmps))
-                               break;
-                   if (*tmps && stat(str->str_ptr,&statbuf) < 0)
-                       goto keepgoing;         /* unmatched wildcard? */
-               }
-               if (gimme == G_ARRAY) {
-                   if (str->str_len - str->str_cur > 20) {
-                       str->str_len = str->str_cur+1;
-                       Renew(str->str_ptr, str->str_len, char);
-                   }
-                   str_2mortal(str);
-                   if (++sp > stack->ary_max) {
-                       astore(stack, sp, Nullstr);
-                       st = stack->ary_array;
-                   }
-                   str = Str_new(58,80);
-                   goto keepgoing;
-               }
-               else if (!tmplen && str->str_len - str->str_cur > 80) {
-                   /* try to reclaim a bit of scalar space on 1st alloc */
-                   if (str->str_cur < 60)
-                       str->str_len = 80;
-                   else
-                       str->str_len = str->str_cur+40; /* allow some slop */
-                   Renew(str->str_ptr, str->str_len, char);
-               }
-           }
-           rschar = old_rschar;
-           rslen = old_rslen;
-#ifdef DEBUGGING
-           tmps = "READ";
-#endif
-           break;
-       }
-#ifdef DEBUGGING
-       if (debug & 8) {
-           if (strEQ(tmps, "NULL"))
-               deb("%d.%s\n",anum,tmps);
-           else
-               deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp]));
-       }
-#endif
-       if (anum < 8)
-           arglast[anum] = sp;
-    }
-
-    if (ppaddr[optype]) {
-       int status;
-
-       /* pretend like we've been maintaining stack_* all along */
-       stack_ary = stack->ary_array;
-       stack_sp = stack_ary + sp;
-       if (mark[optype] && stack_mark != arglast[0])
-           warn("Inconsistent stack mark %d != %d", stack_mark, arglast[0]);
-       stack_max = stack_ary + stack->ary_max;
-
-       status = (*ppaddr[optype])(str, arg, gimme);
-
-       if (savestack->ary_fill > mymarkbase) {
-           warn("Inconsistent stack base");
-           restorelist(mymarkbase);
-       }
-       sp = stack_sp - stack_ary;
-       if (sp < arglast[0])
-           warn("TOO MANY POPS");
-       st += arglast[0];
-       goto array_return;
-    }
-
-    st += arglast[0];
-
-#ifdef SMALLSWITCHES
-    if (optype < O_CHOWN)
-#endif
-    switch (optype) {
-    case O_RCAT:
-       STABSET(str);
-       break;
-    case O_ITEM:
-       if (gimme == G_ARRAY)
-           goto array_return;
-       /* FALL THROUGH */
-    case O_SCALAR:
-       STR_SSET(str,st[1]);
-       STABSET(str);
-       break;
-    case O_ITEM2:
-       if (gimme == G_ARRAY)
-           goto array_return;
-       --anum;
-       STR_SSET(str,st[arglast[anum]-arglast[0]]);
-       STABSET(str);
-       break;
-    case O_ITEM3:
-       if (gimme == G_ARRAY)
-       goto array_return;
-       --anum;
-       STR_SSET(str,st[arglast[anum]-arglast[0]]);
-       STABSET(str);
-       break;
-    case O_CONCAT:
-       STR_SSET(str,st[1]);
-       str_scat(str,st[2]);
-       STABSET(str);
-       break;
-    case O_REPEAT:
-       if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) {
-           sp = do_repeatary(arglast);
-           goto array_return;
-       }
-       STR_SSET(str,st[1]);
-       anum = (int)str_gnum(st[2]);
-       if (anum >= 1) {
-           tmpstr = Str_new(50, 0);
-           tmps = str_get(str);
-           str_nset(tmpstr,tmps,str->str_cur);
-           tmps = str_get(tmpstr);     /* force to be string */
-           STR_GROW(str, (anum * str->str_cur) + 1);
-           repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
-           str->str_cur *= anum;
-           str->str_ptr[str->str_cur] = '\0';
-           str->str_nok = 0;
-           str_free(tmpstr);
-       }
-       else {
-           if (dowarn && st[2]->str_pok && !looks_like_number(st[2]))
-               warn("Right operand of x is not numeric");
-           str_sset(str,&str_no);
-       }
-       STABSET(str);
-       break;
-    case O_MATCH:
-       sp = do_match(str,arg,
-         gimme,arglast);
-       if (gimme == G_ARRAY)
-           goto array_return;
-       STABSET(str);
-       break;
-    case O_NMATCH:
-       sp = do_match(str,arg,
-         G_SCALAR,arglast);
-       str_sset(str, str_true(str) ? &str_no : &str_yes);
-       STABSET(str);
-       break;
-    case O_SUBST:
-       sp = do_subst(str,arg,arglast[0]);
-       goto array_return;
-    case O_NSUBST:
-       sp = do_subst(str,arg,arglast[0]);
-       str = arg->arg_ptr.arg_str;
-       str_set(str, str_true(str) ? No : Yes);
-       goto array_return;
-    case O_ASSIGN:
-       if (arg[1].arg_flags & AF_ARYOK) {
-           if (arg->arg_len == 1) {
-               arg->arg_type = O_LOCAL;
-               goto local;
-           }
-           else {
-               arg->arg_type = O_AASSIGN;
-               goto aassign;
-           }
-       }
-       else {
-           arg->arg_type = O_SASSIGN;
-           goto sassign;
-       }
-    case O_LOCAL:
-      local:
-       arglast[2] = arglast[1];        /* push a null array */
-       /* FALL THROUGH */
-    case O_AASSIGN:
-      aassign:
-       sp = do_assign(arg,
-         gimme,arglast);
-       goto array_return;
-    case O_SASSIGN:
-      sassign:
-#ifdef TAINT
-       if (tainted && !st[2]->str_tainted)
-           tainted = 0;
-#endif
-       STR_SSET(str, st[2]);
-       STABSET(str);
-       break;
-    case O_CHOP:
-       st -= arglast[0];
-       str = arg->arg_ptr.arg_str;
-       for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
-           do_chop(str,st[sp]);
-       st += arglast[0];
-       break;
-    case O_DEFINED:
-       if (arg[1].arg_type & A_DONT) {
-           sp = do_defined(str,arg,
-                 gimme,arglast);
-           goto array_return;
-       }
-       else if (str->str_pok || str->str_nok)
-           goto say_yes;
-       goto say_no;
-    case O_UNDEF:
-       if (arg[1].arg_type & A_DONT) {
-           sp = do_undef(str,arg,
-             gimme,arglast);
-           goto array_return;
-       }
-       else if (str != stab_val(defstab)) {
-           if (str->str_len) {
-               if (str->str_state == SS_INCR)
-                   Str_Grow(str,0);
-               Safefree(str->str_ptr);
-               str->str_ptr = Nullch;
-               str->str_len = 0;
-           }
-           str->str_pok = str->str_nok = 0;
-           STABSET(str);
-       }
-       goto say_undef;
-    case O_STUDY:
-       sp = do_study(str,arg,
-         gimme,arglast);
-       goto array_return;
-    case O_POW:
-       value = str_gnum(st[1]);
-       value = pow(value,str_gnum(st[2]));
-       goto donumset;
-    case O_MULTIPLY:
-       value = str_gnum(st[1]);
-       value *= str_gnum(st[2]);
-       goto donumset;
-    case O_DIVIDE:
-       if ((value = str_gnum(st[2])) == 0.0)
-           fatal("Illegal division by zero");
-#ifdef SLOPPYDIVIDE
-       /* insure that 20./5. == 4. */
-       {
-           double x;
-           int    k;
-           x =  str_gnum(st[1]);
-           if ((double)(int)x     == x &&
-               (double)(int)value == value &&
-               (k = (int)x/(int)value)*(int)value == (int)x) {
-               value = k;
-           } else {
-               value = x/value;
-           }
-       }
-#else
-       value = str_gnum(st[1]) / value;
-#endif
-       goto donumset;
-    case O_MODULO:
-       tmpulong = (unsigned long) str_gnum(st[2]);
-       if (tmpulong == 0L)
-           fatal("Illegal modulus zero");
-#ifndef lint
-       value = str_gnum(st[1]);
-       if (value >= 0.0)
-           value = (double)(((unsigned long)value) % tmpulong);
-       else {
-           tmplong = (long)value;
-           value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
-       }
-#endif
-       goto donumset;
-    case O_ADD:
-       value = str_gnum(st[1]);
-       value += str_gnum(st[2]);
-       goto donumset;
-    case O_SUBTRACT:
-       value = str_gnum(st[1]);
-       value -= str_gnum(st[2]);
-       goto donumset;
-    case O_LEFT_SHIFT:
-       value = str_gnum(st[1]);
-       anum = (int)str_gnum(st[2]);
-#ifndef lint
-       value = (double)(U_L(value) << anum);
-#endif
-       goto donumset;
-    case O_RIGHT_SHIFT:
-       value = str_gnum(st[1]);
-       anum = (int)str_gnum(st[2]);
-#ifndef lint
-       value = (double)(U_L(value) >> anum);
-#endif
-       goto donumset;
-    case O_LT:
-       value = str_gnum(st[1]);
-       value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
-       goto donumset;
-    case O_GT:
-       value = str_gnum(st[1]);
-       value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
-       goto donumset;
-    case O_LE:
-       value = str_gnum(st[1]);
-       value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
-       goto donumset;
-    case O_GE:
-       value = str_gnum(st[1]);
-       value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
-       goto donumset;
-    case O_EQ:
-       if (dowarn) {
-           if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
-               (!st[2]->str_nok && !looks_like_number(st[2])) )
-               warn("Possible use of == on string value");
-       }
-       value = str_gnum(st[1]);
-       value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
-       goto donumset;
-    case O_NE:
-       value = str_gnum(st[1]);
-       value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
-       goto donumset;
-    case O_NCMP:
-       value = str_gnum(st[1]);
-       value -= str_gnum(st[2]);
-       if (value > 0.0)
-           value = 1.0;
-       else if (value < 0.0)
-           value = -1.0;
-       goto donumset;
-    case O_BIT_AND:
-       if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
-           value = str_gnum(st[1]);
-#ifndef lint
-           value = (double)(U_L(value) & U_L(str_gnum(st[2])));
-#endif
-           goto donumset;
-       }
-       else
-           do_vop(optype,str,st[1],st[2]);
-       break;
-    case O_XOR:
-       if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
-           value = str_gnum(st[1]);
-#ifndef lint
-           value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
-#endif
-           goto donumset;
-       }
-       else
-           do_vop(optype,str,st[1],st[2]);
-       break;
-    case O_BIT_OR:
-       if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
-           value = str_gnum(st[1]);
-#ifndef lint
-           value = (double)(U_L(value) | U_L(str_gnum(st[2])));
-#endif
-           goto donumset;
-       }
-       else
-           do_vop(optype,str,st[1],st[2]);
-       break;
-/* use register in evaluating str_true() */
-    case O_AND:
-       if (str_true(st[1])) {
-           anum = 2;
-           optype = O_ITEM2;
-           argflags = arg[anum].arg_flags;
-           if (gimme == G_ARRAY)
-               argflags |= AF_ARYOK;
-           argtype = arg[anum].arg_type & A_MASK;
-           argptr = arg[anum].arg_ptr;
-           maxarg = anum = 1;
-           sp = arglast[0];
-           st -= sp;
-           goto re_eval;
-       }
-       else {
-           if (assigning) {
-               str_sset(str, st[1]);
-               STABSET(str);
-           }
-           else
-               str = st[1];
-           break;
-       }
-    case O_OR:
-       if (str_true(st[1])) {
-           if (assigning) {
-               str_sset(str, st[1]);
-               STABSET(str);
-           }
-           else
-               str = st[1];
-           break;
-       }
-       else {
-           anum = 2;
-           optype = O_ITEM2;
-           argflags = arg[anum].arg_flags;
-           if (gimme == G_ARRAY)
-               argflags |= AF_ARYOK;
-           argtype = arg[anum].arg_type & A_MASK;
-           argptr = arg[anum].arg_ptr;
-           maxarg = anum = 1;
-           sp = arglast[0];
-           st -= sp;
-           goto re_eval;
-       }
-    case O_COND_EXPR:
-       anum = (str_true(st[1]) ? 2 : 3);
-       optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
-       argflags = arg[anum].arg_flags;
-       if (gimme == G_ARRAY)
-           argflags |= AF_ARYOK;
-       argtype = arg[anum].arg_type & A_MASK;
-       argptr = arg[anum].arg_ptr;
-       maxarg = anum = 1;
-       sp = arglast[0];
-       st -= sp;
-       goto re_eval;
-    case O_COMMA:
-       if (gimme == G_ARRAY)
-           goto array_return;
-       str = st[2];
-       break;
-    case O_NEGATE:
-       value = -str_gnum(st[1]);
-       goto donumset;
-    case O_NOT:
-#ifdef NOTNOT
-       { char xxx = str_true(st[1]); value = (double) !xxx; }
-#else
-       value = (double) !str_true(st[1]);
-#endif
-       goto donumset;
-    case O_COMPLEMENT:
-       if (!sawvec || st[1]->str_nok) {
-#ifndef lint
-           value = (double) ~U_L(str_gnum(st[1]));
-#endif
-           goto donumset;
-       }
-       else {
-           STR_SSET(str,st[1]);
-           tmps = str_get(str);
-           for (anum = str->str_cur; anum; anum--, tmps++)
-               *tmps = ~*tmps;
-       }
-       break;
-    case O_SELECT:
-       stab_efullname(str,defoutstab);
-       if (maxarg > 0) {
-           if ((arg[1].arg_type & A_MASK) == A_WORD)
-               defoutstab = arg[1].arg_ptr.arg_stab;
-           else
-               defoutstab = stabent(str_get(st[1]),TRUE);
-           if (!stab_io(defoutstab))
-               stab_io(defoutstab) = stio_new();
-           curoutstab = defoutstab;
-       }
-       STABSET(str);
-       break;
-    case O_WRITE:
-       if (maxarg == 0)
-           stab = defoutstab;
-       else if ((arg[1].arg_type & A_MASK) == A_WORD) {
-           if (!(stab = arg[1].arg_ptr.arg_stab))
-               stab = defoutstab;
-       }
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if (!stab_io(stab)) {
-           str_set(str, No);
-           STABSET(str);
-           break;
-       }
-       curoutstab = stab;
-       fp = stab_io(stab)->ofp;
-       if (stab_io(stab)->fmt_stab)
-           form = stab_form(stab_io(stab)->fmt_stab);
-       else
-           form = stab_form(stab);
-       if (!form || !fp) {
-           if (dowarn) {
-               if (form)
-                   warn("No format for filehandle");
-               else {
-                   if (stab_io(stab)->ifp)
-                       warn("Filehandle only opened for input");
-                   else
-                       warn("Write on closed filehandle");
-               }
-           }
-           str_set(str, No);
-           STABSET(str);
-           break;
-       }
-       format(&outrec,form,sp);
-       do_write(&outrec,stab,sp);
-       if (stab_io(stab)->flags & IOF_FLUSH)
-           (void)fflush(fp);
-       str_set(str, Yes);
-       STABSET(str);
-       break;
-    case O_DBMOPEN:
-#ifdef SOME_DBM
-       anum = arg[1].arg_type & A_MASK;
-       if (anum == A_WORD || anum == A_STAB)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if (st[3]->str_nok || st[3]->str_pok)
-           anum = (int)str_gnum(st[3]);
-       else
-           anum = -1;
-       value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
-       goto donumset;
-#else
-       fatal("No dbm or ndbm on this machine");
-#endif
-    case O_DBMCLOSE:
-#ifdef SOME_DBM
-       anum = arg[1].arg_type & A_MASK;
-       if (anum == A_WORD || anum == A_STAB)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       hdbmclose(stab_hash(stab));
-       goto say_yes;
-#else
-       fatal("No dbm or ndbm on this machine");
-#endif
-    case O_OPEN:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       tmps = str_get(st[2]);
-       if (do_open(stab,tmps,st[2]->str_cur)) {
-           value = (double)forkprocess;
-           stab_io(stab)->lines = 0;
-           goto donumset;
-       }
-       else if (forkprocess == 0)              /* we are a new child */
-           goto say_zero;
-       else
-           goto say_undef;
-       /* break; */
-    case O_TRANS:
-       value = (double) do_trans(str,arg);
-       str = arg->arg_ptr.arg_str;
-       goto donumset;
-    case O_NTRANS:
-       str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
-       str = arg->arg_ptr.arg_str;
-       break;
-    case O_CLOSE:
-       if (maxarg == 0)
-           stab = defoutstab;
-       else if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       str_set(str, do_close(stab,TRUE) ? Yes : No );
-       STABSET(str);
-       break;
-    case O_EACH:
-       sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
-         gimme,arglast);
-       goto array_return;
-    case O_VALUES:
-    case O_KEYS:
-       sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
-         gimme,arglast);
-       goto array_return;
-    case O_LARRAY:
-       str->str_nok = str->str_pok = 0;
-       str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
-       str->str_state = SS_ARY;
-       break;
-    case O_ARRAY:
-       ary = stab_array(arg[1].arg_ptr.arg_stab);
-       maxarg = ary->ary_fill + 1;
-       if (gimme == G_ARRAY) { /* array wanted */
-           sp = arglast[0];
-           st -= sp;
-           if (maxarg > 0 && sp + maxarg > stack->ary_max) {
-               astore(stack,sp + maxarg, Nullstr);
-               st = stack->ary_array;
-           }
-           st += sp;
-           Copy(ary->ary_array, &st[1], maxarg, STR*);
-           sp += maxarg;
-           goto array_return;
-       }
-       else {
-           value = (double)maxarg;
-           goto donumset;
-       }
-    case O_AELEM:
-       anum = ((int)str_gnum(st[2])) - arybase;
-       str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
-       break;
-    case O_DELETE:
-       tmpstab = arg[1].arg_ptr.arg_stab;
-       tmps = str_get(st[2]);
-       str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
-       if (tmpstab == envstab)
-           my_setenv(tmps,Nullch);
-       if (!str)
-           goto say_undef;
-       break;
-    case O_LHASH:
-       str->str_nok = str->str_pok = 0;
-       str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
-       str->str_state = SS_HASH;
-       break;
-    case O_HASH:
-       if (gimme == G_ARRAY) { /* array wanted */
-           sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
-               gimme,arglast);
-           goto array_return;
-       }
-       else {
-           tmpstab = arg[1].arg_ptr.arg_stab;
-           if (!stab_hash(tmpstab)->tbl_fill)
-               goto say_zero;
-           sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
-               stab_hash(tmpstab)->tbl_max+1);
-           str_set(str,buf);
-       }
-       break;
-    case O_HELEM:
-       tmpstab = arg[1].arg_ptr.arg_stab;
-       tmps = str_get(st[2]);
-       str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
-       break;
-    case O_LAELEM:
-       anum = ((int)str_gnum(st[2])) - arybase;
-       str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
-       if (!str || str == &str_undef)
-           fatal("Assignment to non-creatable value, subscript %d",anum);
-       break;
-    case O_LHELEM:
-       tmpstab = arg[1].arg_ptr.arg_stab;
-       tmps = str_get(st[2]);
-       anum = st[2]->str_cur;
-       str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
-       if (!str || str == &str_undef)
-           fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
-       if (tmpstab == envstab)         /* heavy wizardry going on here */
-           str_magic(str, tmpstab, 'E', tmps, anum);   /* str is now magic */
-                                       /* he threw the brick up into the air */
-       else if (tmpstab == sigstab)
-           str_magic(str, tmpstab, 'S', tmps, anum);
-#ifdef SOME_DBM
-       else if (stab_hash(tmpstab)->tbl_dbm)
-           str_magic(str, tmpstab, 'D', tmps, anum);
-#endif
-       else if (tmpstab == DBline)
-           str_magic(str, tmpstab, 'L', tmps, anum);
-       break;
-    case O_LSLICE:
-       anum = 2;
-       argtype = FALSE;
-       goto do_slice_already;
-    case O_ASLICE:
-       anum = 1;
-       argtype = FALSE;
-       goto do_slice_already;
-    case O_HSLICE:
-       anum = 0;
-       argtype = FALSE;
-       goto do_slice_already;
-    case O_LASLICE:
-       anum = 1;
-       argtype = TRUE;
-       goto do_slice_already;
-    case O_LHSLICE:
-       anum = 0;
-       argtype = TRUE;
-      do_slice_already:
-       sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
-           gimme,arglast);
-       goto array_return;
-    case O_SPLICE:
-       sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
-       goto array_return;
-    case O_PUSH:
-       if (arglast[2] - arglast[1] != 1)
-           str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
-       else {
-           str = Str_new(51,0);                /* must copy the STR */
-           str_sset(str,st[2]);
-           (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
-       }
-       break;
-    case O_POP:
-       str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
-       goto staticalization;
-    case O_SHIFT:
-       str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
-      staticalization:
-       if (!str)
-           goto say_undef;
-       if (ary->ary_flags & ARF_REAL)
-           (void)str_2mortal(str);
-       break;
-    case O_UNPACK:
-       sp = do_unpack(str,gimme,arglast);
-       goto array_return;
-    case O_SPLIT:
-       value = str_gnum(st[3]);
-       sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
-         gimme,arglast);
-       goto array_return;
-    case O_LENGTH:
-       if (maxarg < 1)
-           value = (double)str_len(stab_val(defstab));
-       else
-           value = (double)str_len(st[1]);
-       goto donumset;
-    case O_SPRINTF:
-       do_sprintf(str, sp-arglast[0], st+1);
-       break;
-    case O_SUBSTR:
-       anum = ((int)str_gnum(st[2])) - arybase;        /* anum=where to start*/
-       tmps = str_get(st[1]);          /* force conversion to string */
-       /*SUPPRESS 560*/
-       if (argtype = (str == st[1]))
-           str = arg->arg_ptr.arg_str;
-       if (anum < 0)
-           anum += st[1]->str_cur + arybase;
-       if (anum < 0 || anum > st[1]->str_cur)
-           str_nset(str,"",0);
-       else {
-           optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
-           if (optype < 0)
-               optype = 0;
-           tmps += anum;
-           anum = st[1]->str_cur - anum;       /* anum=how many bytes left*/
-           if (anum > optype)
-               anum = optype;
-           str_nset(str, tmps, anum);
-           if (argtype) {                      /* it's an lvalue! */
-               Lstring *lstr = (Lstring*)str;
-
-               str->str_magic = st[1];
-               st[1]->str_rare = 's';
-               lstr->lstr_offset = tmps - str_get(st[1]); 
-               lstr->lstr_len = anum; 
-           }
-       }
-       break;
-    case O_PACK:
-       /*SUPPRESS 701*/
-       (void)do_pack(str,arglast);
-       break;
-    case O_GREP:
-       sp = do_grep(arg,str,gimme,arglast);
-       goto array_return;
-    case O_JOIN:
-       do_join(str,arglast);
-       break;
-    case O_SLT:
-       tmps = str_get(st[1]);
-       value = (double) (str_cmp(st[1],st[2]) < 0);
-       goto donumset;
-    case O_SGT:
-       tmps = str_get(st[1]);
-       value = (double) (str_cmp(st[1],st[2]) > 0);
-       goto donumset;
-    case O_SLE:
-       tmps = str_get(st[1]);
-       value = (double) (str_cmp(st[1],st[2]) <= 0);
-       goto donumset;
-    case O_SGE:
-       tmps = str_get(st[1]);
-       value = (double) (str_cmp(st[1],st[2]) >= 0);
-       goto donumset;
-    case O_SEQ:
-       tmps = str_get(st[1]);
-       value = (double) str_eq(st[1],st[2]);
-       goto donumset;
-    case O_SNE:
-       tmps = str_get(st[1]);
-       value = (double) !str_eq(st[1],st[2]);
-       goto donumset;
-    case O_SCMP:
-       tmps = str_get(st[1]);
-       value = (double) str_cmp(st[1],st[2]);
-       goto donumset;
-    case O_SUBR:
-       sp = do_subr(arg,gimme,arglast);
-       st = stack->ary_array + arglast[0];             /* maybe realloced */
-       goto array_return;
-    case O_DBSUBR:
-       sp = do_subr(arg,gimme,arglast);
-       st = stack->ary_array + arglast[0];             /* maybe realloced */
-       goto array_return;
-    case O_CALLER:
-       sp = do_caller(arg,maxarg,gimme,arglast);
-       st = stack->ary_array + arglast[0];             /* maybe realloced */
-       goto array_return;
-    case O_SORT:
-       sp = do_sort(str,arg,
-         gimme,arglast);
-       goto array_return;
-    case O_REVERSE:
-       if (gimme == G_ARRAY)
-           sp = do_reverse(arglast);
-       else
-           sp = do_sreverse(str, arglast);
-       goto array_return;
-    case O_WARN:
-       if (arglast[2] - arglast[1] != 1) {
-           do_join(str,arglast);
-           tmps = str_get(str);
-       }
-       else {
-           str = st[2];
-           tmps = str_get(st[2]);
-       }
-       if (!tmps || !*tmps)
-           tmps = "Warning: something's wrong";
-       warn("%s",tmps);
-       goto say_yes;
-    case O_DIE:
-       if (arglast[2] - arglast[1] != 1) {
-           do_join(str,arglast);
-           tmps = str_get(str);
-       }
-       else {
-           str = st[2];
-           tmps = str_get(st[2]);
-       }
-       if (!tmps || !*tmps)
-           tmps = "Died";
-       fatal("%s",tmps);
-       goto say_zero;
-    case O_PRTF:
-    case O_PRINT:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if (!stab)
-           stab = defoutstab;
-       if (!stab_io(stab)) {
-           if (dowarn)
-               warn("Filehandle never opened");
-           goto say_zero;
-       }
-       if (!(fp = stab_io(stab)->ofp)) {
-           if (dowarn)  {
-               if (stab_io(stab)->ifp)
-                   warn("Filehandle opened only for input");
-               else
-                   warn("Print on closed filehandle");
-           }
-           goto say_zero;
-       }
-       else {
-           if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
-               value = (double)do_aprint(arg,fp,arglast);
-           else {
-               value = (double)do_print(st[2],fp);
-               if (orslen && optype == O_PRINT)
-                   if (fwrite(ors, 1, orslen, fp) == 0)
-                       goto say_zero;
-           }
-           if (stab_io(stab)->flags & IOF_FLUSH)
-               if (fflush(fp) == EOF)
-                   goto say_zero;
-       }
-       goto donumset;
-    case O_CHDIR:
-       if (maxarg < 1)
-           tmps = Nullch;
-       else
-           tmps = str_get(st[1]);
-       if (!tmps || !*tmps) {
-           tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
-           tmps = str_get(tmpstr);
-       }
-       if (!tmps || !*tmps) {
-           tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
-           tmps = str_get(tmpstr);
-       }
-#ifdef TAINT
-       TAINT_PROPER("chdir");
-#endif
-       value = (double)(chdir(tmps) >= 0);
-       goto donumset;
-    case O_EXIT:
-       if (maxarg < 1)
-           anum = 0;
-       else
-           anum = (int)str_gnum(st[1]);
-       my_exit(anum);
-       goto say_zero;
-    case O_RESET:
-       if (maxarg < 1)
-           tmps = "";
-       else
-           tmps = str_get(st[1]);
-       str_reset(tmps,curcmd->c_stash);
-       value = 1.0;
-       goto donumset;
-    case O_LIST:
-       if (gimme == G_ARRAY)
-           goto array_return;
-       if (maxarg > 0)
-           str = st[sp - arglast[0]];  /* unwanted list, return last item */
-       else
-           str = &str_undef;
-       break;
-    case O_EOF:
-       if (maxarg <= 0)
-           stab = last_in_stab;
-       else if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       str_set(str, do_eof(stab) ? Yes : No);
-       STABSET(str);
-       break;
-    case O_GETC:
-       if (maxarg <= 0)
-           stab = stdinstab;
-       else if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if (!stab)
-           stab = argvstab;
-       if (!stab || do_eof(stab)) /* make sure we have fp with something */
-           goto say_undef;
-       else {
-#ifdef TAINT
-           tainted = 1;
-#endif
-           str_set(str," ");
-           *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
-       }
-       STABSET(str);
-       break;
-    case O_TELL:
-       if (maxarg <= 0)
-           stab = last_in_stab;
-       else if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-#ifndef lint
-       value = (double)do_tell(stab);
-#else
-       (void)do_tell(stab);
-#endif
-       goto donumset;
-    case O_RECV:
-    case O_READ:
-    case O_SYSREAD:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       tmps = str_get(st[2]);
-       anum = (int)str_gnum(st[3]);
-       errno = 0;
-       maxarg = sp - arglast[0];
-       if (maxarg > 4)
-           warn("Too many args on read");
-       if (maxarg == 4)
-           maxarg = (int)str_gnum(st[4]);
-       else
-           maxarg = 0;
-       if (!stab_io(stab) || !stab_io(stab)->ifp)
-           goto say_undef;
-#ifdef HAS_SOCKET
-       if (optype == O_RECV) {
-           argtype = sizeof buf;
-           STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));  /* sneaky */
-           anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg,
-               buf, &argtype);
-           if (anum >= 0) {
-               st[2]->str_cur = anum;
-               st[2]->str_ptr[anum] = '\0';
-               str_nset(str,buf,argtype);
-           }
-           else
-               str_sset(str,&str_undef);
-           break;
-       }
-#else
-       if (optype == O_RECV)
-           goto badsock;
-#endif
-       STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
-       if (optype == O_SYSREAD) {
-           anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
-       }
-       else
-#ifdef HAS_SOCKET
-       if (stab_io(stab)->type == 's') {
-           argtype = sizeof buf;
-           anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0,
-               buf, &argtype);
-       }
-       else
-#endif
-           anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
-       if (anum < 0)
-           goto say_undef;
-       st[2]->str_cur = anum+maxarg;
-       st[2]->str_ptr[anum+maxarg] = '\0';
-       value = (double)anum;
-       goto donumset;
-    case O_SYSWRITE:
-    case O_SEND:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       tmps = str_get(st[2]);
-       anum = (int)str_gnum(st[3]);
-       errno = 0;
-       stio = stab_io(stab);
-       maxarg = sp - arglast[0];
-       if (!stio || !stio->ifp) {
-           anum = -1;
-           if (dowarn) {
-               if (optype == O_SYSWRITE)
-                   warn("Syswrite on closed filehandle");
-               else
-                   warn("Send on closed socket");
-           }
-       }
-       else if (optype == O_SYSWRITE) {
-           if (maxarg > 4)
-               warn("Too many args on syswrite");
-           if (maxarg == 4)
-               optype = (int)str_gnum(st[4]);
-           else
-               optype = 0;
-           anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
-       }
-#ifdef HAS_SOCKET
-       else if (maxarg >= 4) {
-           if (maxarg > 4)
-               warn("Too many args on send");
-           tmps2 = str_get(st[4]);
-           anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
-             anum, tmps2, st[4]->str_cur);
-       }
-       else
-           anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
-#else
-       else
-           goto badsock;
-#endif
-       if (anum < 0)
-           goto say_undef;
-       value = (double)anum;
-       goto donumset;
-    case O_SEEK:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       value = str_gnum(st[2]);
-       str_set(str, do_seek(stab,
-         (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
-       STABSET(str);
-       break;
-    case O_RETURN:
-       tmps = "_SUB_";         /* just fake up a "last _SUB_" */
-       optype = O_LAST;
-       if (curcsv && curcsv->wantarray == G_ARRAY) {
-           lastretstr = Nullstr;
-           lastspbase = arglast[1];
-           lastsize = arglast[2] - arglast[1];
-       }
-       else
-           lastretstr = str_mortal(st[arglast[2] - arglast[0]]);
-       goto dopop;
-    case O_REDO:
-    case O_NEXT:
-    case O_LAST:
-       tmps = Nullch;
-       if (maxarg > 0) {
-           tmps = str_get(arg[1].arg_ptr.arg_str);
-         dopop:
-           while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
-             strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
-#ifdef DEBUGGING
-               if (debug & 4) {
-                   deb("(Skipping label #%d %s)\n",loop_ptr,
-                       loop_stack[loop_ptr].loop_label);
-               }
-#endif
-               loop_ptr--;
-           }
-#ifdef DEBUGGING
-           if (debug & 4) {
-               deb("(Found label #%d %s)\n",loop_ptr,
-                   loop_stack[loop_ptr].loop_label);
-           }
-#endif
-       }
-       if (loop_ptr < 0) {
-           if (tmps && strEQ(tmps, "_SUB_"))
-               fatal("Can't return outside a subroutine");
-           fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
-       }
-       if (!lastretstr && optype == O_LAST && lastsize) {
-           st -= arglast[0];
-           st += lastspbase + 1;
-           optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
-           if (optype) {
-               for (anum = lastsize; anum > 0; anum--,st++)
-                   st[optype] = str_mortal(st[0]);
-           }
-           longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
-       }
-       longjmp(loop_stack[loop_ptr].loop_env, optype);
-    case O_DUMP:
-    case O_GOTO:/* shudder */
-       goto_targ = str_get(arg[1].arg_ptr.arg_str);
-       if (!*goto_targ)
-           goto_targ = Nullch;         /* just restart from top */
-       if (optype == O_DUMP) {
-           do_undump = TRUE;
-           my_unexec();
-       }
-       longjmp(top_env, 1);
-    case O_INDEX:
-       tmps = str_get(st[1]);
-       if (maxarg < 3)
-           anum = 0;
-       else {
-           anum = (int) str_gnum(st[3]) - arybase;
-           if (anum < 0)
-               anum = 0;
-           else if (anum > st[1]->str_cur)
-               anum = st[1]->str_cur;
-       }
-#ifndef lint
-       if (!(tmps2 = fbminstr((unsigned char*)tmps + anum,
-         (unsigned char*)tmps + st[1]->str_cur, st[2])))
-#else
-       if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
-#endif
-           value = (double)(-1 + arybase);
-       else
-           value = (double)(tmps2 - tmps + arybase);
-       goto donumset;
-    case O_RINDEX:
-       tmps = str_get(st[1]);
-       tmps2 = str_get(st[2]);
-       if (maxarg < 3)
-           anum = st[1]->str_cur;
-       else {
-           anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
-           if (anum < 0)
-               anum = 0;
-           else if (anum > st[1]->str_cur)
-               anum = st[1]->str_cur;
-       }
-#ifndef lint
-       if (!(tmps2 = rninstr(tmps,  tmps  + anum,
-                             tmps2, tmps2 + st[2]->str_cur)))
-#else
-       if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
-#endif
-           value = (double)(-1 + arybase);
-       else
-           value = (double)(tmps2 - tmps + arybase);
-       goto donumset;
-    case O_TIME:
-#ifndef lint
-       value = (double) time(Null(long*));
-#endif
-       goto donumset;
-    case O_TMS:
-       sp = do_tms(str,gimme,arglast);
-       goto array_return;
-    case O_LOCALTIME:
-       if (maxarg < 1)
-           (void)time(&when);
-       else
-           when = (time_t)str_gnum(st[1]);
-       sp = do_time(str,localtime(&when),
-         gimme,arglast);
-       goto array_return;
-    case O_GMTIME:
-       if (maxarg < 1)
-           (void)time(&when);
-       else
-           when = (time_t)str_gnum(st[1]);
-       sp = do_time(str,gmtime(&when),
-         gimme,arglast);
-       goto array_return;
-    case O_TRUNCATE:
-       sp = do_truncate(str,arg,
-         gimme,arglast);
-       goto array_return;
-    case O_LSTAT:
-    case O_STAT:
-       sp = do_stat(str,arg,
-         gimme,arglast);
-       goto array_return;
-    case O_CRYPT:
-#ifdef HAS_CRYPT
-       tmps = str_get(st[1]);
-#ifdef FCRYPT
-       str_set(str,fcrypt(tmps,str_get(st[2])));
-#else
-       str_set(str,crypt(tmps,str_get(st[2])));
-#endif
-#else
-       fatal(
-         "The crypt() function is unimplemented due to excessive paranoia.");
-#endif
-       break;
-    case O_ATAN2:
-       value = str_gnum(st[1]);
-       value = atan2(value,str_gnum(st[2]));
-       goto donumset;
-    case O_SIN:
-       if (maxarg < 1)
-           value = str_gnum(stab_val(defstab));
-       else
-           value = str_gnum(st[1]);
-       value = sin(value);
-       goto donumset;
-    case O_COS:
-       if (maxarg < 1)
-           value = str_gnum(stab_val(defstab));
-       else
-           value = str_gnum(st[1]);
-       value = cos(value);
-       goto donumset;
-    case O_RAND:
-       if (maxarg < 1)
-           value = 1.0;
-       else
-           value = str_gnum(st[1]);
-       if (value == 0.0)
-           value = 1.0;
-#if RANDBITS == 31
-       value = rand() * value / 2147483648.0;
-#else
-#if RANDBITS == 16
-       value = rand() * value / 65536.0;
-#else
-#if RANDBITS == 15
-       value = rand() * value / 32768.0;
-#else
-       value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
-#endif
-#endif
-#endif
-       goto donumset;
-    case O_SRAND:
-       if (maxarg < 1) {
-           (void)time(&when);
-           anum = when;
-       }
-       else
-           anum = (int)str_gnum(st[1]);
-       (void)srand(anum);
-       goto say_yes;
-    case O_EXP:
-       if (maxarg < 1)
-           value = str_gnum(stab_val(defstab));
-       else
-           value = str_gnum(st[1]);
-       value = exp(value);
-       goto donumset;
-    case O_LOG:
-       if (maxarg < 1)
-           value = str_gnum(stab_val(defstab));
-       else
-           value = str_gnum(st[1]);
-       if (value <= 0.0)
-           fatal("Can't take log of %g\n", value);
-       value = log(value);
-       goto donumset;
-    case O_SQRT:
-       if (maxarg < 1)
-           value = str_gnum(stab_val(defstab));
-       else
-           value = str_gnum(st[1]);
-       if (value < 0.0)
-           fatal("Can't take sqrt of %g\n", value);
-       value = sqrt(value);
-       goto donumset;
-    case O_INT:
-       if (maxarg < 1)
-           value = str_gnum(stab_val(defstab));
-       else
-           value = str_gnum(st[1]);
-       if (value >= 0.0)
-           (void)modf(value,&value);
-       else {
-           (void)modf(-value,&value);
-           value = -value;
-       }
-       goto donumset;
-    case O_ORD:
-       if (maxarg < 1)
-           tmps = str_get(stab_val(defstab));
-       else
-           tmps = str_get(st[1]);
-#ifndef I286
-       value = (double) (*tmps & 255);
-#else
-       anum = (int) *tmps;
-       value = (double) (anum & 255);
-#endif
-       goto donumset;
-    case O_ALARM:
-#ifdef HAS_ALARM
-       if (maxarg < 1)
-           tmps = str_get(stab_val(defstab));
-       else
-           tmps = str_get(st[1]);
-       if (!tmps)
-           tmps = "0";
-       anum = alarm((unsigned int)atoi(tmps));
-       if (anum < 0)
-           goto say_undef;
-       value = (double)anum;
-       goto donumset;
-#else
-       fatal("Unsupported function alarm");
-       break;
-#endif
-    case O_SLEEP:
-       if (maxarg < 1)
-           tmps = Nullch;
-       else
-           tmps = str_get(st[1]);
-       (void)time(&when);
-       if (!tmps || !*tmps)
-           sleep((32767<<16)+32767);
-       else
-           sleep((unsigned int)atoi(tmps));
-#ifndef lint
-       value = (double)when;
-       (void)time(&when);
-       value = ((double)when) - value;
-#endif
-       goto donumset;
-    case O_RANGE:
-       sp = do_range(gimme,arglast);
-       goto array_return;
-    case O_F_OR_R:
-       if (gimme == G_ARRAY) {         /* it's a range */
-           /* can we optimize to constant array? */
-           if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
-             (arg[2].arg_type & A_MASK) == A_SINGLE) {
-               st[2] = arg[2].arg_ptr.arg_str;
-               sp = do_range(gimme,arglast);
-               st = stack->ary_array;
-               maxarg = sp - arglast[0];
-               str_free(arg[1].arg_ptr.arg_str);
-               arg[1].arg_ptr.arg_str = Nullstr;
-               str_free(arg[2].arg_ptr.arg_str);
-               arg[2].arg_ptr.arg_str = Nullstr;
-               arg->arg_type = O_ARRAY;
-               arg[1].arg_type = A_STAB|A_DONT;
-               arg->arg_len = 1;
-               stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
-               ary = stab_array(stab);
-               afill(ary,maxarg - 1);
-               anum = maxarg;
-               st += arglast[0]+1;
-               while (maxarg-- > 0)
-                   ary->ary_array[maxarg] = str_smake(st[maxarg]);
-               st -= arglast[0]+1;
-               goto array_return;
-           }
-           arg->arg_type = optype = O_RANGE;
-           maxarg = arg->arg_len = 2;
-           anum = 2;
-           arg[anum].arg_flags &= ~AF_ARYOK;
-           argflags = arg[anum].arg_flags;
-           argtype = arg[anum].arg_type & A_MASK;
-           arg[anum].arg_type = argtype;
-           argptr = arg[anum].arg_ptr;
-           sp = arglast[0];
-           st -= sp;
-           sp++;
-           goto re_eval;
-       }
-       arg->arg_type = O_FLIP;
-       /* FALL THROUGH */
-    case O_FLIP:
-       if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
-         last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
-         :
-         str_true(st[1]) ) {
-           arg[2].arg_type &= ~A_DONT;
-           arg[1].arg_type |= A_DONT;
-           arg->arg_type = optype = O_FLOP;
-           if (arg->arg_flags & AF_COMMON) {
-               str_numset(str,0.0);
-               anum = 2;
-               argflags = arg[2].arg_flags;
-               argtype = arg[2].arg_type & A_MASK;
-               argptr = arg[2].arg_ptr;
-               sp = arglast[0];
-               st -= sp++;
-               goto re_eval;
-           }
-           else {
-               str_numset(str,1.0);
-               break;
-           }
-       }
-       str_set(str,"");
-       break;
-    case O_FLOP:
-       str_inc(str);
-       if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
-         last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
-         :
-         str_true(st[2]) ) {
-           arg->arg_type = O_FLIP;
-           arg[1].arg_type &= ~A_DONT;
-           arg[2].arg_type |= A_DONT;
-           str_cat(str,"E0");
-       }
-       break;
-    case O_FORK:
-#ifdef HAS_FORK
-       anum = fork();
-       if (anum < 0)
-           goto say_undef;
-       if (!anum) {
-           /*SUPPRESS 560*/
-           if (tmpstab = stabent("$",allstabs))
-               str_numset(STAB_STR(tmpstab),(double)getpid());
-           hclear(pidstatus, FALSE);   /* no kids, so don't wait for 'em */
-       }
-       value = (double)anum;
-       goto donumset;
-#else
-       fatal("Unsupported function fork");
-       break;
-#endif
-    case O_WAIT:
-#ifdef HAS_WAIT
-#ifndef lint
-       anum = wait(&argflags);
-       if (anum > 0)
-           pidgone(anum,argflags);
-       value = (double)anum;
-#endif
-       statusvalue = (unsigned short)argflags;
-       goto donumset;
-#else
-       fatal("Unsupported function wait");
-       break;
-#endif
-    case O_WAITPID:
-#ifdef HAS_WAIT
-#ifndef lint
-       anum = (int)str_gnum(st[1]);
-       optype = (int)str_gnum(st[2]);
-       anum = wait4pid(anum, &argflags,optype);
-       value = (double)anum;
-#endif
-       statusvalue = (unsigned short)argflags;
-       goto donumset;
-#else
-       fatal("Unsupported function wait");
-       break;
-#endif
-    case O_SYSTEM:
-#ifdef HAS_FORK
-#ifdef TAINT
-       if (arglast[2] - arglast[1] == 1) {
-           taintenv();
-           tainted |= st[2]->str_tainted;
-           TAINT_PROPER("system");
-       }
-#endif
-       while ((anum = vfork()) == -1) {
-           if (errno != EAGAIN) {
-               value = -1.0;
-               goto donumset;
-           }
-           sleep(5);
-       }
-       if (anum > 0) {
-#ifndef lint
-           ihand = signal(SIGINT, SIG_IGN);
-           qhand = signal(SIGQUIT, SIG_IGN);
-           argtype = wait4pid(anum, &argflags, 0);
-#else
-           ihand = qhand = 0;
-#endif
-           (void)signal(SIGINT, ihand);
-           (void)signal(SIGQUIT, qhand);
-           statusvalue = (unsigned short)argflags;
-           if (argtype < 0)
-               value = -1.0;
-           else {
-               value = (double)((unsigned int)argflags & 0xffff);
-           }
-           do_execfree();      /* free any memory child malloced on vfork */
-           goto donumset;
-       }
-       if ((arg[1].arg_type & A_MASK) == A_STAB)
-           value = (double)do_aexec(st[1],arglast);
-       else if (arglast[2] - arglast[1] != 1)
-           value = (double)do_aexec(Nullstr,arglast);
-       else {
-           value = (double)do_exec(str_get(str_mortal(st[2])));
-       }
-       _exit(-1);
-#else /* ! FORK */
-       if ((arg[1].arg_type & A_MASK) == A_STAB)
-           value = (double)do_aspawn(st[1],arglast);
-       else if (arglast[2] - arglast[1] != 1)
-           value = (double)do_aspawn(Nullstr,arglast);
-       else {
-           value = (double)do_spawn(str_get(str_mortal(st[2])));
-       }
-       goto donumset;
-#endif /* FORK */
-    case O_EXEC_OP:
-       if ((arg[1].arg_type & A_MASK) == A_STAB)
-           value = (double)do_aexec(st[1],arglast);
-       else if (arglast[2] - arglast[1] != 1)
-           value = (double)do_aexec(Nullstr,arglast);
-       else {
-#ifdef TAINT
-           taintenv();
-           tainted |= st[2]->str_tainted;
-           TAINT_PROPER("exec");
-#endif
-           value = (double)do_exec(str_get(str_mortal(st[2])));
-       }
-       goto donumset;
-    case O_HEX:
-       if (maxarg < 1)
-           tmps = str_get(stab_val(defstab));
-       else
-           tmps = str_get(st[1]);
-       value = (double)scanhex(tmps, 99, &argtype);
-       goto donumset;
-
-    case O_OCT:
-       if (maxarg < 1)
-           tmps = str_get(stab_val(defstab));
-       else
-           tmps = str_get(st[1]);
-       while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
-           tmps++;
-       if (*tmps == 'x')
-           value = (double)scanhex(++tmps, 99, &argtype);
-       else
-           value = (double)scanoct(tmps, 99, &argtype);
-       goto donumset;
-
-/* These common exits are hidden here in the middle of the switches for the
-   benefit of those machines with limited branch addressing.  Sigh.  */
-
-array_return:
-#ifdef DEBUGGING
-    if (debug) {
-       dlevel--;
-       if (debug & 8) {
-           anum = sp - arglast[0];
-           switch (anum) {
-           case 0:
-               deb("%s RETURNS ()\n",opname[optype]);
-               break;
-           case 1:
-               deb("%s RETURNS (\"%s\")\n",opname[optype],
-                   st[1] ? str_get(st[1]) : "");
-               break;
-           default:
-               tmps = st[1] ? str_get(st[1]) : "";
-               deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
-                 anum,tmps,anum==2?"":"...,",
-                       st[anum] ? str_get(st[anum]) : "");
-               break;
-           }
-       }
-    }
-#endif
-    stack_ary = stack->ary_array;
-    stack_max = stack_ary + stack->ary_max;
-    stack_sp = stack_ary + sp;
-    return sp;
-
-say_yes:
-    str = &str_yes;
-    goto normal_return;
-
-say_no:
-    str = &str_no;
-    goto normal_return;
-
-say_undef:
-    str = &str_undef;
-    goto normal_return;
-
-say_zero:
-    value = 0.0;
-    /* FALL THROUGH */
-
-donumset:
-    str_numset(str,value);
-    STABSET(str);
-    st[1] = str;
-#ifdef DEBUGGING
-    if (debug) {
-       dlevel--;
-       if (debug & 8)
-           deb("%s RETURNS \"%f\"\n",opname[optype],value);
-    }
-#endif
-    stack_ary = stack->ary_array;
-    stack_max = stack_ary + stack->ary_max;
-    stack_sp = stack_ary + arglast[0] + 1;
-    return arglast[0] + 1;
-#ifdef SMALLSWITCHES
-    }
-    else
-    switch (optype) {
-#endif
-    case O_CHOWN:
-#ifdef HAS_CHOWN
-       value = (double)apply(optype,arglast);
-       goto donumset;
-#else
-       fatal("Unsupported function chown");
-       break;
-#endif
-    case O_KILL:
-#ifdef HAS_KILL
-       value = (double)apply(optype,arglast);
-       goto donumset;
-#else
-       fatal("Unsupported function kill");
-       break;
-#endif
-    case O_UNLINK:
-    case O_CHMOD:
-    case O_UTIME:
-       value = (double)apply(optype,arglast);
-       goto donumset;
-    case O_UMASK:
-#ifdef HAS_UMASK
-       if (maxarg < 1) {
-           anum = umask(0);
-           (void)umask(anum);
-       }
-       else
-           anum = umask((int)str_gnum(st[1]));
-       value = (double)anum;
-#ifdef TAINT
-       TAINT_PROPER("umask");
-#endif
-       goto donumset;
-#else
-       fatal("Unsupported function umask");
-       break;
-#endif
-#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
-    case O_MSGGET:
-    case O_SHMGET:
-    case O_SEMGET:
-       if ((anum = do_ipcget(optype, arglast)) == -1)
-           goto say_undef;
-       value = (double)anum;
-       goto donumset;
-    case O_MSGCTL:
-    case O_SHMCTL:
-    case O_SEMCTL:
-       anum = do_ipcctl(optype, arglast);
-       if (anum == -1)
-           goto say_undef;
-       if (anum != 0) {
-           value = (double)anum;
-           goto donumset;
-       }
-       str_set(str,"0 but true");
-       STABSET(str);
-       break;
-    case O_MSGSND:
-       value = (double)(do_msgsnd(arglast) >= 0);
-       goto donumset;
-    case O_MSGRCV:
-       value = (double)(do_msgrcv(arglast) >= 0);
-       goto donumset;
-    case O_SEMOP:
-       value = (double)(do_semop(arglast) >= 0);
-       goto donumset;
-    case O_SHMREAD:
-    case O_SHMWRITE:
-       value = (double)(do_shmio(optype, arglast) >= 0);
-       goto donumset;
-#else /* not SYSVIPC */
-    case O_MSGGET:
-    case O_MSGCTL:
-    case O_MSGSND:
-    case O_MSGRCV:
-    case O_SEMGET:
-    case O_SEMCTL:
-    case O_SEMOP:
-    case O_SHMGET:
-    case O_SHMCTL:
-    case O_SHMREAD:
-    case O_SHMWRITE:
-       fatal("System V IPC is not implemented on this machine");
-#endif /* not SYSVIPC */
-    case O_RENAME:
-       tmps = str_get(st[1]);
-       tmps2 = str_get(st[2]);
-#ifdef TAINT
-       TAINT_PROPER("rename");
-#endif
-#ifdef HAS_RENAME
-       value = (double)(rename(tmps,tmps2) >= 0);
-#else
-       if (same_dirent(tmps2, tmps))   /* can always rename to same name */
-           anum = 1;
-       else {
-           if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
-               (void)UNLINK(tmps2);
-           if (!(anum = link(tmps,tmps2)))
-               anum = UNLINK(tmps);
-       }
-       value = (double)(anum >= 0);
-#endif
-       goto donumset;
-    case O_LINK:
-#ifdef HAS_LINK
-       tmps = str_get(st[1]);
-       tmps2 = str_get(st[2]);
-#ifdef TAINT
-       TAINT_PROPER("link");
-#endif
-       value = (double)(link(tmps,tmps2) >= 0);
-       goto donumset;
-#else
-       fatal("Unsupported function link");
-       break;
-#endif
-    case O_MKDIR:
-       tmps = str_get(st[1]);
-       anum = (int)str_gnum(st[2]);
-#ifdef TAINT
-       TAINT_PROPER("mkdir");
-#endif
-#ifdef HAS_MKDIR
-       value = (double)(mkdir(tmps,anum) >= 0);
-       goto donumset;
-#else
-       (void)strcpy(buf,"mkdir ");
-#endif
-#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
-      one_liner:
-       for (tmps2 = buf+6; *tmps; ) {
-           *tmps2++ = '\\';
-           *tmps2++ = *tmps++;
-       }
-       (void)strcpy(tmps2," 2>&1");
-       rsfp = mypopen(buf,"r");
-       if (rsfp) {
-           *buf = '\0';
-           tmps2 = fgets(buf,sizeof buf,rsfp);
-           (void)mypclose(rsfp);
-           if (tmps2 != Nullch) {
-               for (errno = 1; errno < sys_nerr; errno++) {
-                   if (instr(buf,sys_errlist[errno]))  /* you don't see this */
-                       goto say_zero;
-               }
-               errno = 0;
-#ifndef EACCES
-#define EACCES EPERM
-#endif
-               if (instr(buf,"cannot make"))
-                   errno = EEXIST;
-               else if (instr(buf,"existing file"))
-                   errno = EEXIST;
-               else if (instr(buf,"ile exists"))
-                   errno = EEXIST;
-               else if (instr(buf,"non-exist"))
-                   errno = ENOENT;
-               else if (instr(buf,"does not exist"))
-                   errno = ENOENT;
-               else if (instr(buf,"not empty"))
-                   errno = EBUSY;
-               else if (instr(buf,"cannot access"))
-                   errno = EACCES;
-               else
-                   errno = EPERM;
-               goto say_zero;
-           }
-           else {      /* some mkdirs return no failure indication */
-               tmps = str_get(st[1]);
-               anum = (stat(tmps,&statbuf) >= 0);
-               if (optype == O_RMDIR)
-                   anum = !anum;
-               if (anum)
-                   errno = 0;
-               else
-                   errno = EACCES;     /* a guess */
-               value = (double)anum;
-           }
-           goto donumset;
-       }
-       else
-           goto say_zero;
-#endif
-    case O_RMDIR:
-       if (maxarg < 1)
-           tmps = str_get(stab_val(defstab));
-       else
-           tmps = str_get(st[1]);
-#ifdef TAINT
-       TAINT_PROPER("rmdir");
-#endif
-#ifdef HAS_RMDIR
-       value = (double)(rmdir(tmps) >= 0);
-       goto donumset;
-#else
-       (void)strcpy(buf,"rmdir ");
-       goto one_liner;         /* see above in HAS_MKDIR */
-#endif
-    case O_GETPPID:
-#ifdef HAS_GETPPID
-       value = (double)getppid();
-       goto donumset;
-#else
-       fatal("Unsupported function getppid");
-       break;
-#endif
-    case O_GETPGRP:
-#ifdef HAS_GETPGRP
-       if (maxarg < 1)
-           anum = 0;
-       else
-           anum = (int)str_gnum(st[1]);
-#ifdef _POSIX_SOURCE
-       if (anum != 0)
-           fatal("POSIX getpgrp can't take an argument");
-       value = (double)getpgrp();
-#else
-       value = (double)getpgrp(anum);
-#endif
-       goto donumset;
-#else
-       fatal("The getpgrp() function is unimplemented on this machine");
-       break;
-#endif
-    case O_SETPGRP:
-#ifdef HAS_SETPGRP
-       argtype = (int)str_gnum(st[1]);
-       anum = (int)str_gnum(st[2]);
-#ifdef TAINT
-       TAINT_PROPER("setpgrp");
-#endif
-       value = (double)(setpgrp(argtype,anum) >= 0);
-       goto donumset;
-#else
-       fatal("The setpgrp() function is unimplemented on this machine");
-       break;
-#endif
-    case O_GETPRIORITY:
-#ifdef HAS_GETPRIORITY
-       argtype = (int)str_gnum(st[1]);
-       anum = (int)str_gnum(st[2]);
-       value = (double)getpriority(argtype,anum);
-       goto donumset;
-#else
-       fatal("The getpriority() function is unimplemented on this machine");
-       break;
-#endif
-    case O_SETPRIORITY:
-#ifdef HAS_SETPRIORITY
-       argtype = (int)str_gnum(st[1]);
-       anum = (int)str_gnum(st[2]);
-       optype = (int)str_gnum(st[3]);
-#ifdef TAINT
-       TAINT_PROPER("setpriority");
-#endif
-       value = (double)(setpriority(argtype,anum,optype) >= 0);
-       goto donumset;
-#else
-       fatal("The setpriority() function is unimplemented on this machine");
-       break;
-#endif
-    case O_CHROOT:
-#ifdef HAS_CHROOT
-       if (maxarg < 1)
-           tmps = str_get(stab_val(defstab));
-       else
-           tmps = str_get(st[1]);
-#ifdef TAINT
-       TAINT_PROPER("chroot");
-#endif
-       value = (double)(chroot(tmps) >= 0);
-       goto donumset;
-#else
-       fatal("Unsupported function chroot");
-       break;
-#endif
-    case O_FCNTL:
-    case O_IOCTL:
-       if (maxarg <= 0)
-           stab = last_in_stab;
-       else if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       argtype = U_I(str_gnum(st[2]));
-#ifdef TAINT
-       TAINT_PROPER("ioctl");
-#endif
-       anum = do_ctl(optype,stab,argtype,st[3]);
-       if (anum == -1)
-           goto say_undef;
-       if (anum != 0) {
-           value = (double)anum;
-           goto donumset;
-       }
-       str_set(str,"0 but true");
-       STABSET(str);
-       break;
-    case O_FLOCK:
-#ifdef HAS_FLOCK
-       if (maxarg <= 0)
-           stab = last_in_stab;
-       else if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if (stab && stab_io(stab))
-           fp = stab_io(stab)->ifp;
-       else
-           fp = Nullfp;
-       if (fp) {
-           argtype = (int)str_gnum(st[2]);
-           value = (double)(flock(fileno(fp),argtype) >= 0);
-       }
-       else
-           value = 0;
-       goto donumset;
-#else
-       fatal("The flock() function is unimplemented on this machine");
-       break;
-#endif
-    case O_UNSHIFT:
-       ary = stab_array(arg[1].arg_ptr.arg_stab);
-       if (arglast[2] - arglast[1] != 1)
-           do_unshift(ary,arglast);
-       else {
-           STR *tmpstr = Str_new(52,0);        /* must copy the STR */
-           str_sset(tmpstr,st[2]);
-           aunshift(ary,1);
-           (void)astore(ary,0,tmpstr);
-       }
-       value = (double)(ary->ary_fill + 1);
-       goto donumset;
-
-    case O_TRY:
-       sp = do_try(arg[1].arg_ptr.arg_cmd,
-           gimme,arglast);
-       goto array_return;
-
-    case O_EVALONCE:
-       sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
-           gimme,arglast);
-       if (eval_root) {
-           str_free(arg[1].arg_ptr.arg_str);
-           arg[1].arg_ptr.arg_cmd = eval_root;
-           arg[1].arg_type = (A_CMD|A_DONT);
-           arg[0].arg_type = O_TRY;
-       }
-       goto array_return;
-
-    case O_REQUIRE:
-    case O_DOFILE:
-    case O_EVAL:
-       if (maxarg < 1)
-           tmpstr = stab_val(defstab);
-       else
-           tmpstr =
-             (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
-#ifdef TAINT
-       tainted |= tmpstr->str_tainted;
-       TAINT_PROPER("eval");
-#endif
-       sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
-           gimme,arglast);
-       goto array_return;
-
-    case O_FTRREAD:
-       argtype = 0;
-       anum = S_IRUSR;
-       goto check_perm;
-    case O_FTRWRITE:
-       argtype = 0;
-       anum = S_IWUSR;
-       goto check_perm;
-    case O_FTREXEC:
-       argtype = 0;
-       anum = S_IXUSR;
-       goto check_perm;
-    case O_FTEREAD:
-       argtype = 1;
-       anum = S_IRUSR;
-       goto check_perm;
-    case O_FTEWRITE:
-       argtype = 1;
-       anum = S_IWUSR;
-       goto check_perm;
-    case O_FTEEXEC:
-       argtype = 1;
-       anum = S_IXUSR;
-      check_perm:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (cando(anum,argtype,&statcache))
-           goto say_yes;
-       goto say_no;
-
-    case O_FTIS:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       goto say_yes;
-    case O_FTEOWNED:
-    case O_FTROWNED:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
-           goto say_yes;
-       goto say_no;
-    case O_FTZERO:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (!statcache.st_size)
-           goto say_yes;
-       goto say_no;
-    case O_FTSIZE:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       value = (double)statcache.st_size;
-       goto donumset;
-
-    case O_FTMTIME:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       value = (double)(basetime - statcache.st_mtime) / 86400.0;
-       goto donumset;
-    case O_FTATIME:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       value = (double)(basetime - statcache.st_atime) / 86400.0;
-       goto donumset;
-    case O_FTCTIME:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       value = (double)(basetime - statcache.st_ctime) / 86400.0;
-       goto donumset;
-
-    case O_FTSOCK:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (S_ISSOCK(statcache.st_mode))
-           goto say_yes;
-       goto say_no;
-    case O_FTCHR:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (S_ISCHR(statcache.st_mode))
-           goto say_yes;
-       goto say_no;
-    case O_FTBLK:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (S_ISBLK(statcache.st_mode))
-           goto say_yes;
-       goto say_no;
-    case O_FTFILE:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (S_ISREG(statcache.st_mode))
-           goto say_yes;
-       goto say_no;
-    case O_FTDIR:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (S_ISDIR(statcache.st_mode))
-           goto say_yes;
-       goto say_no;
-    case O_FTPIPE:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (S_ISFIFO(statcache.st_mode))
-           goto say_yes;
-       goto say_no;
-    case O_FTLINK:
-       if (mylstat(arg,st[1]) < 0)
-           goto say_undef;
-       if (S_ISLNK(statcache.st_mode))
-           goto say_yes;
-       goto say_no;
-    case O_SYMLINK:
-#ifdef HAS_SYMLINK
-       tmps = str_get(st[1]);
-       tmps2 = str_get(st[2]);
-#ifdef TAINT
-       TAINT_PROPER("symlink");
-#endif
-       value = (double)(symlink(tmps,tmps2) >= 0);
-       goto donumset;
-#else
-       fatal("Unsupported function symlink");
-#endif
-    case O_READLINK:
-#ifdef HAS_SYMLINK
-       if (maxarg < 1)
-           tmps = str_get(stab_val(defstab));
-       else
-           tmps = str_get(st[1]);
-       anum = readlink(tmps,buf,sizeof buf);
-       if (anum < 0)
-           goto say_undef;
-       str_nset(str,buf,anum);
-       break;
-#else
-       goto say_undef;         /* just pretend it's a normal file */
-#endif
-    case O_FTSUID:
-#ifdef S_ISUID
-       anum = S_ISUID;
-       goto check_xid;
-#else
-       goto say_no;
-#endif
-    case O_FTSGID:
-#ifdef S_ISGID
-       anum = S_ISGID;
-       goto check_xid;
-#else
-       goto say_no;
-#endif
-    case O_FTSVTX:
-#ifdef S_ISVTX
-       anum = S_ISVTX;
-#else
-       goto say_no;
-#endif
-      check_xid:
-       if (mystat(arg,st[1]) < 0)
-           goto say_undef;
-       if (statcache.st_mode & anum)
-           goto say_yes;
-       goto say_no;
-    case O_FTTTY:
-       if (arg[1].arg_type & A_DONT) {
-           stab = arg[1].arg_ptr.arg_stab;
-           tmps = "";
-       }
-       else
-           stab = stabent(tmps = str_get(st[1]),FALSE);
-       if (stab && stab_io(stab) && stab_io(stab)->ifp)
-           anum = fileno(stab_io(stab)->ifp);
-       else if (isDIGIT(*tmps))
-           anum = atoi(tmps);
-       else
-           goto say_undef;
-       if (isatty(anum))
-           goto say_yes;
-       goto say_no;
-    case O_FTTEXT:
-    case O_FTBINARY:
-       str = do_fttext(arg,st[1]);
-       break;
-#ifdef HAS_SOCKET
-    case O_SOCKET:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-#ifndef lint
-       value = (double)do_socket(stab,arglast);
-#else
-       (void)do_socket(stab,arglast);
-#endif
-       goto donumset;
-    case O_BIND:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-#ifndef lint
-       value = (double)do_bind(stab,arglast);
-#else
-       (void)do_bind(stab,arglast);
-#endif
-       goto donumset;
-    case O_CONNECT:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-#ifndef lint
-       value = (double)do_connect(stab,arglast);
-#else
-       (void)do_connect(stab,arglast);
-#endif
-       goto donumset;
-    case O_LISTEN:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-#ifndef lint
-       value = (double)do_listen(stab,arglast);
-#else
-       (void)do_listen(stab,arglast);
-#endif
-       goto donumset;
-    case O_ACCEPT:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if ((arg[2].arg_type & A_MASK) == A_WORD)
-           stab2 = arg[2].arg_ptr.arg_stab;
-       else
-           stab2 = stabent(str_get(st[2]),TRUE);
-       do_accept(str,stab,stab2);
-       STABSET(str);
-       break;
-    case O_GHBYNAME:
-       if (maxarg < 1)
-           goto say_undef;
-    case O_GHBYADDR:
-    case O_GHOSTENT:
-       sp = do_ghent(optype,
-         gimme,arglast);
-       goto array_return;
-    case O_GNBYNAME:
-       if (maxarg < 1)
-           goto say_undef;
-    case O_GNBYADDR:
-    case O_GNETENT:
-       sp = do_gnent(optype,
-         gimme,arglast);
-       goto array_return;
-    case O_GPBYNAME:
-       if (maxarg < 1)
-           goto say_undef;
-    case O_GPBYNUMBER:
-    case O_GPROTOENT:
-       sp = do_gpent(optype,
-         gimme,arglast);
-       goto array_return;
-    case O_GSBYNAME:
-       if (maxarg < 1)
-           goto say_undef;
-    case O_GSBYPORT:
-    case O_GSERVENT:
-       sp = do_gsent(optype,
-         gimme,arglast);
-       goto array_return;
-    case O_SHOSTENT:
-       value = (double) sethostent((int)str_gnum(st[1]));
-       goto donumset;
-    case O_SNETENT:
-       value = (double) setnetent((int)str_gnum(st[1]));
-       goto donumset;
-    case O_SPROTOENT:
-       value = (double) setprotoent((int)str_gnum(st[1]));
-       goto donumset;
-    case O_SSERVENT:
-       value = (double) setservent((int)str_gnum(st[1]));
-       goto donumset;
-    case O_EHOSTENT:
-       value = (double) endhostent();
-       goto donumset;
-    case O_ENETENT:
-       value = (double) endnetent();
-       goto donumset;
-    case O_EPROTOENT:
-       value = (double) endprotoent();
-       goto donumset;
-    case O_ESERVENT:
-       value = (double) endservent();
-       goto donumset;
-    case O_SOCKPAIR:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if ((arg[2].arg_type & A_MASK) == A_WORD)
-           stab2 = arg[2].arg_ptr.arg_stab;
-       else
-           stab2 = stabent(str_get(st[2]),TRUE);
-#ifndef lint
-       value = (double)do_spair(stab,stab2,arglast);
-#else
-       (void)do_spair(stab,stab2,arglast);
-#endif
-       goto donumset;
-    case O_SHUTDOWN:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-#ifndef lint
-       value = (double)do_shutdown(stab,arglast);
-#else
-       (void)do_shutdown(stab,arglast);
-#endif
-       goto donumset;
-    case O_GSOCKOPT:
-    case O_SSOCKOPT:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       sp = do_sopt(optype,stab,arglast);
-       goto array_return;
-    case O_GETSOCKNAME:
-    case O_GETPEERNAME:
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if (!stab)
-           goto say_undef;
-       sp = do_getsockname(optype,stab,arglast);
-       goto array_return;
-
-#else /* HAS_SOCKET not defined */
-    case O_SOCKET:
-    case O_BIND:
-    case O_CONNECT:
-    case O_LISTEN:
-    case O_ACCEPT:
-    case O_SOCKPAIR:
-    case O_GHBYNAME:
-    case O_GHBYADDR:
-    case O_GHOSTENT:
-    case O_GNBYNAME:
-    case O_GNBYADDR:
-    case O_GNETENT:
-    case O_GPBYNAME:
-    case O_GPBYNUMBER:
-    case O_GPROTOENT:
-    case O_GSBYNAME:
-    case O_GSBYPORT:
-    case O_GSERVENT:
-    case O_SHOSTENT:
-    case O_SNETENT:
-    case O_SPROTOENT:
-    case O_SSERVENT:
-    case O_EHOSTENT:
-    case O_ENETENT:
-    case O_EPROTOENT:
-    case O_ESERVENT:
-    case O_SHUTDOWN:
-    case O_GSOCKOPT:
-    case O_SSOCKOPT:
-    case O_GETSOCKNAME:
-    case O_GETPEERNAME:
-      badsock:
-       fatal("Unsupported socket function");
-#endif /* HAS_SOCKET */
-    case O_SSELECT:
-#ifdef HAS_SELECT
-       sp = do_select(gimme,arglast);
-       goto array_return;
-#else
-       fatal("select not implemented");
-#endif
-    case O_FILENO:
-       if (maxarg < 1)
-           goto say_undef;
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
-           goto say_undef;
-       value = fileno(fp);
-       goto donumset;
-    case O_BINMODE:
-       if (maxarg < 1)
-           goto say_undef;
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
-           goto say_undef;
-#ifdef DOSISH
-#ifdef atarist
-       if(fflush(fp))
-          str_set(str, No);
-       else
-       {
-           fp->_flag |= _IOBIN;
-           str_set(str, Yes);
-       }
-#else
-       str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
-#endif
-#else
-       str_set(str, Yes);
-#endif
-       STABSET(str);
-       break;
-    case O_VEC:
-       sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
-       goto array_return;
-    case O_GPWNAM:
-    case O_GPWUID:
-    case O_GPWENT:
-#ifdef HAS_PASSWD
-       sp = do_gpwent(optype,
-         gimme,arglast);
-       goto array_return;
-    case O_SPWENT:
-       value = (double) setpwent();
-       goto donumset;
-    case O_EPWENT:
-       value = (double) endpwent();
-       goto donumset;
-#else
-    case O_EPWENT:
-    case O_SPWENT:
-       fatal("Unsupported password function");
-       break;
-#endif
-    case O_GGRNAM:
-    case O_GGRGID:
-    case O_GGRENT:
-#ifdef HAS_GROUP
-       sp = do_ggrent(optype,
-         gimme,arglast);
-       goto array_return;
-    case O_SGRENT:
-       value = (double) setgrent();
-       goto donumset;
-    case O_EGRENT:
-       value = (double) endgrent();
-       goto donumset;
-#else
-    case O_EGRENT:
-    case O_SGRENT:
-       fatal("Unsupported group function");
-       break;
-#endif
-    case O_GETLOGIN:
-#ifdef HAS_GETLOGIN
-       if (!(tmps = getlogin()))
-           goto say_undef;
-       str_set(str,tmps);
-#else
-       fatal("Unsupported function getlogin");
-#endif
-       break;
-    case O_OPEN_DIR:
-    case O_READDIR:
-    case O_TELLDIR:
-    case O_SEEKDIR:
-    case O_REWINDDIR:
-    case O_CLOSEDIR:
-       if (maxarg < 1)
-           goto say_undef;
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if (!stab)
-           goto say_undef;
-       sp = do_dirop(optype,stab,gimme,arglast);
-       goto array_return;
-    case O_SYSCALL:
-       value = (double)do_syscall(arglast);
-       goto donumset;
-    case O_PIPE_OP:
-#ifdef HAS_PIPE
-       if ((arg[1].arg_type & A_MASK) == A_WORD)
-           stab = arg[1].arg_ptr.arg_stab;
-       else
-           stab = stabent(str_get(st[1]),TRUE);
-       if ((arg[2].arg_type & A_MASK) == A_WORD)
-           stab2 = arg[2].arg_ptr.arg_stab;
-       else
-           stab2 = stabent(str_get(st[2]),TRUE);
-       do_pipe(str,stab,stab2);
-       STABSET(str);
-#else
-       fatal("Unsupported function pipe");
-#endif
-       break;
-    }
-
-  normal_return:
-    st[1] = str;
-#ifdef DEBUGGING
-    if (debug) {
-       dlevel--;
-       if (debug & 8)
-           deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
-    }
-#endif
-    stack_ary = stack->ary_array;
-    stack_max = stack_ary + stack->ary_max;
-    stack_sp = stack_ary + arglast[0] + 1;
-    return arglast[0] + 1;
-}
index b5d4a88..f940a59 100644 (file)
@@ -21,7 +21,7 @@ register int sp;
 register int items;
 {
     if (items < 5 || items > 6) {
-       fatal("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)");
+       croak("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)");
     }
     {
        char *  dbtype = SvPV(ST(1),na);
@@ -33,7 +33,7 @@ register int items;
        GDBM_File       RETVAL;
 
        if (items < 6)
-           fatal_func = (FATALFUNC)fatal;
+           fatal_func = (FATALFUNC)croak;
        else {
            fatal_func = (FATALFUNC)SvPV(ST(6),na);
        }
@@ -52,7 +52,7 @@ register int sp;
 register int items;
 {
     if (items < 4 || items > 5) {
-       fatal("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)");
+       croak("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)");
     }
     {
        char *  name = SvPV(ST(1),na);
@@ -63,7 +63,7 @@ register int items;
        GDBM_File       RETVAL;
 
        if (items < 5)
-           fatal_func = (FATALFUNC)fatal;
+           fatal_func = (FATALFUNC)croak;
        else {
            fatal_func = (FATALFUNC)SvPV(ST(5),na);
        }
@@ -82,15 +82,15 @@ register int sp;
 register int items;
 {
     if (items < 1 || items > 1) {
-       fatal("Usage: GDBM_File::close(db)");
+       croak("Usage: GDBM_File::close(db)");
     }
     {
        GDBM_File       db;
 
        if (sv_isa(ST(1), "GDBM_File"))
-           db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type GDBM_File");
+           croak("db is not of type GDBM_File");
 
        gdbm_close(db);
     }
@@ -104,15 +104,15 @@ register int sp;
 register int items;
 {
     if (items < 1 || items > 1) {
-       fatal("Usage: GDBM_File::DESTROY(db)");
+       croak("Usage: GDBM_File::DESTROY(db)");
     }
     {
        GDBM_File       db;
 
        if (sv_isa(ST(1), "GDBM_File"))
-           db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type GDBM_File");
+           croak("db is not of type GDBM_File");
        gdbm_close(db);
     }
     return sp;
@@ -125,7 +125,7 @@ register int sp;
 register int items;
 {
     if (items < 2 || items > 2) {
-       fatal("Usage: GDBM_File::fetch(db, key)");
+       croak("Usage: GDBM_File::fetch(db, key)");
     }
     {
        GDBM_File       db;
@@ -133,9 +133,9 @@ register int items;
        gdatum  RETVAL;
 
        if (sv_isa(ST(1), "GDBM_File"))
-           db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type GDBM_File");
+           croak("db is not of type GDBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
@@ -153,7 +153,7 @@ register int sp;
 register int items;
 {
     if (items < 3 || items > 4) {
-       fatal("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)");
+       croak("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)");
     }
     {
        GDBM_File       db;
@@ -163,9 +163,9 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "GDBM_File"))
-           db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type GDBM_File");
+           croak("db is not of type GDBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
@@ -191,7 +191,7 @@ register int sp;
 register int items;
 {
     if (items < 2 || items > 2) {
-       fatal("Usage: GDBM_File::delete(db, key)");
+       croak("Usage: GDBM_File::delete(db, key)");
     }
     {
        GDBM_File       db;
@@ -199,9 +199,9 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "GDBM_File"))
-           db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type GDBM_File");
+           croak("db is not of type GDBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
@@ -219,16 +219,16 @@ register int sp;
 register int items;
 {
     if (items < 1 || items > 1) {
-       fatal("Usage: GDBM_File::firstkey(db)");
+       croak("Usage: GDBM_File::firstkey(db)");
     }
     {
        GDBM_File       db;
        gdatum  RETVAL;
 
        if (sv_isa(ST(1), "GDBM_File"))
-           db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type GDBM_File");
+           croak("db is not of type GDBM_File");
 
        RETVAL = gdbm_firstkey(db);
        ST(0) = sv_mortalcopy(&sv_undef);
@@ -244,7 +244,7 @@ register int sp;
 register int items;
 {
     if (items < 2 || items > 2) {
-       fatal("Usage: GDBM_File::nextkey(db, key)");
+       croak("Usage: GDBM_File::nextkey(db, key)");
     }
     {
        GDBM_File       db;
@@ -252,9 +252,9 @@ register int items;
        gdatum  RETVAL;
 
        if (sv_isa(ST(1), "GDBM_File"))
-           db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type GDBM_File");
+           croak("db is not of type GDBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
@@ -272,16 +272,16 @@ register int sp;
 register int items;
 {
     if (items < 1 || items > 1) {
-       fatal("Usage: GDBM_File::reorganize(db)");
+       croak("Usage: GDBM_File::reorganize(db)");
     }
     {
        GDBM_File       db;
        int     RETVAL;
 
        if (sv_isa(ST(1), "GDBM_File"))
-           db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type GDBM_File");
+           croak("db is not of type GDBM_File");
 
        RETVAL = gdbm_reorganize(db);
        ST(0) = sv_mortalcopy(&sv_undef);
@@ -290,7 +290,7 @@ register int items;
     return sp;
 }
 
-int init_GDBM_File(ix,sp,items)
+int boot_GDBM_File(ix,sp,items)
 int ix;
 int sp;
 int items;
index 61afe01..970724d 100644 (file)
@@ -1,14 +1,20 @@
 all: NDBM_File.c ODBM_File.c GDBM_File.c SDBM_File.c
 
 NDBM_File.c: NDBM_File.xs
-       ../xsubpp ../typemap NDBM_File.xs >NDBM_File.c
+       ../xsubpp NDBM_File.xs >NDBM_File.c
 
 SDBM_File.c: SDBM_File.xs
-       ../xsubpp ../typemap SDBM_File.xs >SDBM_File.c
+       ../xsubpp SDBM_File.xs >SDBM_File.c
+
+SDBM_File.o: SDBM_File.c
+       cc -g -I../.. -pic -c SDBM_File.c
+
+SDBM_File.so: SDBM_File.o sdbm/libsdbm.a
+       ld -o SDBM_File.so SDBM_File.o sdbm/libsdbm.a
 
 ODBM_File.c: ODBM_File.xs
-       ../xsubpp ../typemap ODBM_File.xs >ODBM_File.c
+       ../xsubpp ODBM_File.xs >ODBM_File.c
 
 GDBM_File.c: GDBM_File.xs
-       ../xsubpp ../typemap GDBM_File.xs >GDBM_File.c
+       ../xsubpp GDBM_File.xs >GDBM_File.c
 
index b2fa7dd..1aea2ce 100644 (file)
@@ -28,7 +28,7 @@ register int sp;
 register int items;
 {
     if (items < 4 || items > 4) {
-       fatal("Usage: ODBM_File::new(dbtype, filename, flags, mode)");
+       croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)");
     }
     {
        char *  dbtype = SvPV(ST(1),na);
@@ -39,18 +39,18 @@ register int items;
        {
            char tmpbuf[1025];
            if (dbmrefcnt++)
-               fatal("Old dbm can only open one database");
+               croak("Old dbm can only open one database");
            sprintf(tmpbuf,"%s.dir",filename);
            if (stat(tmpbuf, &statbuf) < 0) {
                if (flags & O_CREAT) {
                    if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
-                       fatal("ODBM_File: Can't create %s", filename);
+                       croak("ODBM_File: Can't create %s", filename);
                    sprintf(tmpbuf,"%s.pag",filename);
                    if (close(creat(tmpbuf,mode)) < 0)
-                       fatal("ODBM_File: Can't create %s", filename);
+                       croak("ODBM_File: Can't create %s", filename);
                }
                else
-                   fatal("ODBM_FILE: Can't open %s", filename);
+                   croak("ODBM_FILE: Can't open %s", filename);
            }
            RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
            ST(0) = sv_mortalcopy(&sv_undef);
@@ -67,15 +67,15 @@ register int sp;
 register int items;
 {
     if (items < 1 || items > 1) {
-       fatal("Usage: ODBM_File::DESTROY(db)");
+       croak("Usage: ODBM_File::DESTROY(db)");
     }
     {
        ODBM_File       db;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type ODBM_File");
+           croak("db is not of type ODBM_File");
        dbmrefcnt--;
        dbmclose();
     }
@@ -89,7 +89,7 @@ register int sp;
 register int items;
 {
     if (items < 2 || items > 2) {
-       fatal("Usage: ODBM_File::fetch(db, key)");
+       croak("Usage: ODBM_File::fetch(db, key)");
     }
     {
        ODBM_File       db;
@@ -97,9 +97,9 @@ register int items;
        datum   RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type ODBM_File");
+           croak("db is not of type ODBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
@@ -117,7 +117,7 @@ register int sp;
 register int items;
 {
     if (items < 3 || items > 4) {
-       fatal("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)");
+       croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)");
     }
     {
        ODBM_File       db;
@@ -127,9 +127,9 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type ODBM_File");
+           croak("db is not of type ODBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
@@ -155,7 +155,7 @@ register int sp;
 register int items;
 {
     if (items < 2 || items > 2) {
-       fatal("Usage: ODBM_File::delete(db, key)");
+       croak("Usage: ODBM_File::delete(db, key)");
     }
     {
        ODBM_File       db;
@@ -163,9 +163,9 @@ register int items;
        int     RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type ODBM_File");
+           croak("db is not of type ODBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
@@ -183,16 +183,16 @@ register int sp;
 register int items;
 {
     if (items < 1 || items > 1) {
-       fatal("Usage: ODBM_File::firstkey(db)");
+       croak("Usage: ODBM_File::firstkey(db)");
     }
     {
        ODBM_File       db;
        datum   RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type ODBM_File");
+           croak("db is not of type ODBM_File");
 
        RETVAL = odbm_firstkey(db);
        ST(0) = sv_mortalcopy(&sv_undef);
@@ -208,7 +208,7 @@ register int sp;
 register int items;
 {
     if (items < 2 || items > 2) {
-       fatal("Usage: ODBM_File::nextkey(db, key)");
+       croak("Usage: ODBM_File::nextkey(db, key)");
     }
     {
        ODBM_File       db;
@@ -216,9 +216,9 @@ register int items;
        datum   RETVAL;
 
        if (sv_isa(ST(1), "ODBM_File"))
-           db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+           db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
        else
-           fatal("db is not of type ODBM_File");
+           croak("db is not of type ODBM_File");
 
        key.dptr = SvPV(ST(2), key.dsize);;
 
@@ -229,7 +229,7 @@ register int items;
     return sp;
 }
 
-int init_ODBM_File(ix,sp,items)
+int boot_ODBM_File(ix,sp,items)
 int ix;
 int sp;
 int items;
index 7baafc4..e69de29 100644 (file)
@@ -1,266 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include "ext/dbm/sdbm/sdbm.h"
-
-typedef DBM* SDBM_File;
-#define sdbm_new(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
-
-static int
-XS_SDBM_File_sdbm_new(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
-    if (items < 4 || items > 4) {
-       fatal("Usage: SDBM_File::new(dbtype, filename, flags, mode)");
-    }
-    {
-       char *  dbtype = SvPV(ST(1),na);
-       char *  filename = SvPV(ST(2),na);
-       int     flags = (int)SvIV(ST(3));
-       int     mode = (int)SvIV(ST(4));
-       SDBM_File       RETVAL;
-
-       RETVAL = sdbm_new(dbtype, filename, flags, mode);
-       ST(0) = sv_mortalcopy(&sv_undef);
-       sv_setptrobj(ST(0), RETVAL, "SDBM_File");
-    }
-    return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_DESTROY(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
-    if (items < 1 || items > 1) {
-       fatal("Usage: SDBM_File::DESTROY(db)");
-    }
-    {
-       SDBM_File       db;
-
-       if (sv_isa(ST(1), "SDBM_File"))
-           db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
-       else
-           fatal("db is not of type SDBM_File");
-       sdbm_close(db);
-    }
-    return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_fetch(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
-    if (items < 2 || items > 2) {
-       fatal("Usage: SDBM_File::fetch(db, key)");
-    }
-    {
-       SDBM_File       db;
-       datum   key;
-       datum   RETVAL;
-
-       if (sv_isa(ST(1), "SDBM_File"))
-           db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
-       else
-           fatal("db is not of type SDBM_File");
-
-       key.dptr = SvPV(ST(2), key.dsize);;
-
-       RETVAL = sdbm_fetch(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
-       sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
-    }
-    return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_store(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
-    if (items < 3 || items > 4) {
-       fatal("Usage: SDBM_File::store(db, key, value, flags = DBM_REPLACE)");
-    }
-    {
-       SDBM_File       db;
-       datum   key;
-       datum   value;
-       int     flags;
-       int     RETVAL;
-
-       if (sv_isa(ST(1), "SDBM_File"))
-           db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
-       else
-           fatal("db is not of type SDBM_File");
-
-       key.dptr = SvPV(ST(2), key.dsize);;
-
-       value.dptr = SvPV(ST(3), value.dsize);;
-
-       if (items < 4)
-           flags = DBM_REPLACE;
-       else {
-           flags = (int)SvIV(ST(4));
-       }
-
-       RETVAL = sdbm_store(db, key, value, flags);
-       ST(0) = sv_mortalcopy(&sv_undef);
-       sv_setiv(ST(0), (I32)RETVAL);
-    }
-    return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_delete(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
-    if (items < 2 || items > 2) {
-       fatal("Usage: SDBM_File::delete(db, key)");
-    }
-    {
-       SDBM_File       db;
-       datum   key;
-       int     RETVAL;
-
-       if (sv_isa(ST(1), "SDBM_File"))
-           db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
-       else
-           fatal("db is not of type SDBM_File");
-
-       key.dptr = SvPV(ST(2), key.dsize);;
-
-       RETVAL = sdbm_delete(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
-       sv_setiv(ST(0), (I32)RETVAL);
-    }
-    return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_firstkey(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
-    if (items < 1 || items > 1) {
-       fatal("Usage: SDBM_File::firstkey(db)");
-    }
-    {
-       SDBM_File       db;
-       datum   RETVAL;
-
-       if (sv_isa(ST(1), "SDBM_File"))
-           db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
-       else
-           fatal("db is not of type SDBM_File");
-
-       RETVAL = sdbm_firstkey(db);
-       ST(0) = sv_mortalcopy(&sv_undef);
-       sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
-    }
-    return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_nextkey(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
-    if (items < 2 || items > 2) {
-       fatal("Usage: SDBM_File::nextkey(db, key)");
-    }
-    {
-       SDBM_File       db;
-       datum   key;
-       datum   RETVAL;
-
-       if (sv_isa(ST(1), "SDBM_File"))
-           db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
-       else
-           fatal("db is not of type SDBM_File");
-
-       key.dptr = SvPV(ST(2), key.dsize);;
-
-       RETVAL = sdbm_nextkey(db, key);
-       ST(0) = sv_mortalcopy(&sv_undef);
-       sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
-    }
-    return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_error(ix, sp, items)
-register int ix;
-register int sp;
-