perl 4.0 patch 28: patch #20, continued
authorLarry Wall <lwall@netlabs.com>
Mon, 8 Jun 1992 04:50:30 +0000 (04:50 +0000)
committerLarry Wall <lwall@netlabs.com>
Mon, 8 Jun 1992 04:50:30 +0000 (04:50 +0000)
See patch #20.

12 files changed:
atarist/osbind.pl [new file with mode: 0644]
hints/osf1.sh [new file with mode: 0644]
lib/newgetopt.pl
lib/open2.pl [new file with mode: 0644]
malloc.c
os2/os2.c
os2/perl.cs
os2/perl.def
os2/perldb.dif
os2/perlglob.bad
patchlevel.h
perl.h

diff --git a/atarist/osbind.pl b/atarist/osbind.pl
new file mode 100644 (file)
index 0000000..84f64fb
--- /dev/null
@@ -0,0 +1,382 @@
+#
+#      gemdos/xbios/bios interface on the atari
+#
+#  ++jrb       bammi@cadence.com
+#
+
+# camel book pp204
+sub enum {
+    local($_) = @_;
+    local(@specs) = split(/,/);
+    local($val);
+    for(@specs) {
+        if(/=/) {
+           $val = eval $_;
+        } else {
+           eval $_ . ' = ++$val';
+       }
+    }
+}
+
+# these must match the defines in atarist.c
+
+&enum(<<'EOL');
+$_trap_1_w=1, $_trap_1_ww, $_trap_1_wl, $_trap_1_wlw, $_trap_1_www,
+$_trap_1_wll, $_trap_1_wwll, $_trap_1_wlww, $_trap_1_wwlll, $_trap_13_w,
+$_trap_13_ww, $_trap_13_wl, $_trap_13_www, $_trap_13_wwl, $_trap_13_wwlwww,
+$_trap_14_w, $_trap_14_ww, $_trap_14_wl, $_trap_14_www, $_trap_14_wwl,
+$_trap_14_wwll, $_trap_14_wllw, $_trap_14_wlll, $_trap_14_wwwl,
+$_trap_14_wwwwl, $_trap_14_wllww, $_trap_14_wwwwwww, $_trap_14_wllwwwww,
+$_trap_14_wllwwwwlw, $_trap_14_wllwwwwwlw
+EOL
+
+sub Pterm0 {
+  syscall($_trap_1_w, 0x00);
+}
+sub Cconin {
+  syscall($_trap_1_w, 0x01);
+}
+sub Cconout {
+  syscall($_trap_1_ww, 0x02, @_);
+}
+sub Cauxin {
+  syscall($_trap_1_w, 0x03);
+}
+sub Cauxout {
+  syscall($_trap_1_ww, 0x04, @_);
+}
+sub Cprnout {
+  syscall($_trap_1_ww, 0x05, @_);
+}
+sub Crawio {
+  syscall($_trap_1_ww, 0x06, @_);
+}
+sub Crawcin {
+  syscall($_trap_1_w, 0x07);
+}
+sub Cnecin {
+  syscall($_trap_1_w, 0x08);
+}
+sub Cconws {
+  syscall($_trap_1_wl, 0x09, @_);
+}
+sub Cconrs {
+  syscall($_trap_1_wl, 0x0A, @_);
+}
+sub Cconis {
+  syscall($_trap_1_w, 0x0B);
+}
+sub Dsetdrv {
+  syscall($_trap_1_ww, 0x0E, @_);
+}
+sub Cconos {
+  syscall($_trap_1_w, 0x10);
+}
+sub Cprnos {
+  syscall($_trap_1_w, 0x11);
+}
+sub Cauxis {
+  syscall($_trap_1_w, 0x12);
+}
+sub Cauxos {
+  syscall($_trap_1_w, 0x13);
+}
+sub Dgetdrv {
+  syscall($_trap_1_w, 0x19);
+}
+sub Fsetdta {
+  syscall($_trap_1_wl, 0x1A, @_);
+}
+sub Super {
+  syscall($_trap_1_wl, 0x20, @_);
+}
+sub Tgetdate {
+  syscall($_trap_1_w, 0x2A);
+}
+sub Tsetdate {
+  syscall($_trap_1_ww, 0x2B, @_);
+}
+sub Tgettime {
+  syscall($_trap_1_w, 0x2C);
+}
+sub Tsettime {
+  syscall($_trap_1_ww, 0x2D, @_);
+}
+sub Fgetdta {
+  syscall($_trap_1_w, 0x2F);
+}
+sub Sversion {
+  syscall($_trap_1_w, 0x30);
+}
+sub Ptermres {
+  syscall($_trap_1_wlw, 0x31, @_);
+}
+sub Dfree {
+  syscall($_trap_1_wlw, 0x36, @_);
+}
+sub Dcreate {
+  syscall($_trap_1_wl, 0x39, @_);
+}
+sub Ddelete {
+  syscall($_trap_1_wl, 0x3A, @_);
+}
+sub Dsetpath {
+  syscall($_trap_1_wl, 0x3B, @_);
+}
+sub Fcreate {
+  syscall($_trap_1_wlw, 0x3C, @_);
+}
+sub Fopen {
+  syscall($_trap_1_wlw, 0x3D, @_);
+}
+sub Fclose {
+  syscall($_trap_1_ww, 0x3E, @_);
+}
+sub Fread {
+  syscall($_trap_1_wwll, 0x3F, @_);
+}
+sub Fwrite {
+  syscall($_trap_1_wwll, 0x40, @_);
+}
+sub Fdelete {
+  syscall($_trap_1_wl, 0x41, @_);
+}
+sub Fseek {
+  syscall($_trap_1_wlww, 0x42, @_);
+}
+sub Fattrib {
+  syscall($_trap_1_wlww, 0x43, @_);
+}
+sub Fdup {
+  syscall($_trap_1_ww, 0x45, @_);
+}
+sub Fforce {
+  syscall($_trap_1_www, 0x46, @_);
+}
+sub Dgetpath {
+  syscall($_trap_1_wlw, 0x47, @_);
+}
+sub Malloc {
+  syscall($_trap_1_wl, 0x48, @_);
+}
+sub Mfree {
+  syscall($_trap_1_wl, 0x49, @_);
+}
+sub Mshrink {
+  syscall($_trap_1_wwll, 0x4A, @_);
+}
+sub Pexec {
+  syscall($_trap_1_wwlll, 0x4B, @_);
+}
+sub Pterm {
+  syscall($_trap_1_ww, 0x4C, @_);
+}
+sub Fsfirst {
+  syscall($_trap_1_wlw, 0x4E, @_);
+}
+sub Fsnext {
+  syscall($_trap_1_w, 0x4F);
+}
+sub Frename {
+  syscall($_trap_1_wwll, 0x56, @_);
+}
+sub Fdatime {
+  syscall($_trap_1_wlww, 0x57, @_);
+}
+sub Getmpb {
+  syscall($_trap_13_wl, 0x00, @_);
+}
+sub Bconstat {
+  syscall($_trap_13_ww, 0x01, @_);
+}
+sub Bconin {
+  syscall($_trap_13_ww, 0x02, @_);
+}
+sub Bconout {
+  syscall($_trap_13_www, 0x03, @_);
+}
+sub Rwabs {
+  syscall($_trap_13_wwlwww, 0x04, @_);
+}
+sub Setexc {
+  syscall($_trap_13_wwl, 0x05, @_);
+}
+sub Tickcal {
+  syscall($_trap_13_w, 0x06);
+}
+sub Getbpb {
+  syscall($_trap_13_ww, 0x07, @_);
+}
+sub Bcostat {
+  syscall($_trap_13_ww, 0x08, @_);
+}
+sub Mediach {
+  syscall($_trap_13_ww, 0x09, @_);
+}
+sub Drvmap {
+  syscall($_trap_13_w, 0x0A);
+}
+sub Kbshift {
+  syscall($_trap_13_ww, 0x0B, @_);
+}
+sub Getshift {
+  &Kbshift(-1);
+}
+sub Initmous {
+  syscall($_trap_14_wwll, 0x00, @_);
+}
+sub Ssbrk {
+  syscall($_trap_14_ww, 0x01, @_);
+}
+sub Physbase {
+  syscall($_trap_14_w, 0x02);
+}
+sub Logbase {
+  syscall($_trap_14_w, 0x03);
+}
+sub Getrez {
+  syscall($_trap_14_w, 0x04);
+}
+sub Setscreen {
+  syscall($_trap_14_wllw, 0x05, @_);
+}
+sub Setpallete {
+  syscall($_trap_14_wl, 0x06, @_);
+}
+sub Setcolor {
+  syscall($_trap_14_www, 0x07, @_);
+}
+sub Floprd {
+  syscall($_trap_14_wllwwwww, 0x08, @_);
+}
+sub Flopwr {
+  syscall($_trap_14_wllwwwww, 0x09, @_);
+}
+sub Flopfmt {
+  syscall($_trap_14_wllwwwwwlw, 0x0A, @_);
+}
+sub Midiws {
+  syscall($_trap_14_wwl, 0x0C, @_);
+}
+sub Mfpint {
+  syscall($_trap_14_wwl, 0x0D, @_);
+}
+sub Iorec {
+  syscall($_trap_14_ww, 0x0E, @_);
+}
+sub Rsconf {
+  syscall($_trap_14_wwwwwww, 0x0F, @_);
+}
+sub Keytbl {
+  syscall($_trap_14_wlll, 0x10, @_);
+}
+sub Random {
+  syscall($_trap_14_w, 0x11);
+}
+sub Protobt {
+  syscall($_trap_14_wllww, 0x12, @_);
+}
+sub Flopver {
+  syscall($_trap_14_wllwwwww, 0x13, @_);
+}
+sub Scrdmp {
+  syscall($_trap_14_w, 0x14);
+}
+sub Cursconf {
+  syscall($_trap_14_www, 0x15, @_);
+}
+sub Settime {
+  syscall($_trap_14_wl, 0x16, @_);
+}
+sub Gettime {
+  syscall($_trap_14_w, 0x17);
+}
+sub Bioskeys {
+  syscall($_trap_14_w, 0x18);
+}
+sub Ikbdws {
+  syscall($_trap_14_wwl, 0x19, @_);
+}
+sub Jdisint {
+  syscall($_trap_14_ww, 0x1A, @_);
+}
+sub Jenabint {
+  syscall($_trap_14_ww, 0x1B, @_);
+}
+sub Giaccess {
+  syscall($_trap_14_www, 0x1C, @_);
+}
+sub Offgibit {
+  syscall($_trap_14_ww, 0x1D, @_);
+}
+sub Ongibit {
+  syscall($_trap_14_ww, 0x1E, @_);
+}
+sub Xbtimer {
+  syscall($_trap_14_wwwwl, 0x1E, @_);
+}
+sub Dosound {
+  syscall($_trap_14_wl, 0x20, @_);
+}
+sub Setprt {
+  syscall($_trap_14_ww, 0x21, @_);
+}
+sub Kbdvbase {
+  syscall($_trap_14_w, 0x22);
+}
+sub Kbrate {
+  syscall($_trap_14_www, 0x23, @_);
+}
+sub Prtblk {
+  syscall($_trap_14_wl, 0x24, @_);
+}
+sub Vsync {
+  syscall($_trap_14_w, 0x25);
+}
+sub Supexec {
+  syscall($_trap_14_wl, 0x26, @_);
+}
+sub Blitmode {
+  syscall($_trap_14_ww, 0x40, @_);
+}
+sub Mxalloc {
+  syscall($_trap_1_wlw, 0x44, @_);
+}
+sub Maddalt {
+  syscall($_trap_1_wll, 0x14, @_);
+}
+sub Setpalette {
+  syscall($_trap_14_wl, 0x06, @_);
+}
+sub EsetShift {
+  syscall($_trap_14_ww, 80, @_);
+}
+sub EgetShift {
+  syscall($_trap_14_w, 81);
+}
+sub EsetBank {
+  syscall($_trap_14_ww, 82, @_);
+}
+sub EsetColor {
+  syscall($_trap_14_www, 83, @_);
+}
+sub EsetPalette {
+  syscall($_trap_14_wwwl, 84, @_);
+}
+sub EgetPalette {
+  syscall($_trap_14_wwwl, 85, @_);
+}
+sub EsetGray {
+  syscall($_trap_14_ww, 86, @_);
+}
+sub EsetSmear {
+  syscall($_trap_14_ww, 87, @_);
+}
+sub Bconmap {
+  syscall($_trap_14_ww, 0x2b, @_);
+}
+sub Bconctl {
+  syscall($_trap_14_wwl, 0x2d, @_);
+}
+
+1;
diff --git a/hints/osf1.sh b/hints/osf1.sh
new file mode 100644 (file)
index 0000000..e9be849
--- /dev/null
@@ -0,0 +1,25 @@
+ccflags="$ccflags -Olimit 2900"
+libswanted=m
+tmp=`(uname -a) 2>/dev/null`
+case "$tmp" in
+OSF1*)
+    case "$tmp" in
+    *mips)
+       d_volatile=define
+       ;;
+    *)
+       cat <<EOFM
+You are not supposed to know about that machine...
+EOFM
+       ;; 
+    esac
+    ;;
+esac
+#eval_cflags='optimize="-g"'
+#teval_cflags='optimize="-g"'
+#toke_cflags='optimize="-g"'
+#ttoke_cflags='optimize="-g"'
+regcomp_cflags='optimize="-g -O0"'
+tregcomp_cflags='optimize="-g -O0"'
+regexec_cflags='optimize="-g -O0"'
+tregexec_cflags='optimize="-g -O0"'
index 8782428..0e4cbfd 100644 (file)
@@ -1,11 +1,11 @@
 # newgetopt.pl -- new options parsing
 
-# SCCS Status     : @(#)@ newgetopt.pl 1.8
+# SCCS Status     : @(#)@ newgetopt.pl 1.13
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Thu Sep 26 20:10:41 1991
-# Update Count    : 35
+# Last Modified On: Tue Jun  2 11:24:03 1992
+# Update Count    : 75
 # Status          : Okay
 
 # This package implements a new getopt function. This function adheres
@@ -18,6 +18,8 @@
 #    for mandatory arguments or ":" for optional arguments) and an
 #    argument type specifier: "n" or "i" for integer numbers, "f" for
 #    real (fix) numbers or "s" for strings.
+#    If an "@" sign is appended, the option is treated as an array.
+#    Value(s) are not set, but pushed.
 #
 #  - if the first option of the list consists of non-alphanumeric
 #    characters only, it is interpreted as a generic option starter.
@@ -25,7 +27,7 @@
 #    will be considered an option.
 #    Likewise, a double occurrence (e.g. "--") signals end of
 #    the options list.
-#    The default value for the starter is "-".
+#    The default value for the starter is "-", "--" or "+".
 #
 # Upon return, the option variables, prefixed with "opt_", are defined
 # and set to the respective option arguments, if any.
 #    -foo -bar         -> $opt_foo = '-bar'
 #    -foo --           -> $opt_foo = '--'
 #
-
 # HISTORY 
+# 2-Jun-1992           Johan Vromans   
+#    Do not use //o to allow multiple NGetOpt calls with different delimeters.
+#    Prevent typeless option from using previous $array state.
+#    Prevent empty option from being eaten as a (negative) number.
+
+# 25-May-1992          Johan Vromans   
+#    Add array options. "foo=s@" will return an array @opt_foo that
+#    contains all values that were supplied. E.g. "-foo one -foo -two" will
+#    return @opt_foo = ("one", "-two");
+#    Correct bug in handling options that allow for a argument when followed
+#    by another option.
+
+# 4-May-1992           Johan Vromans   
+#    Add $ignorecase to match options in either case.
+#    Allow '' option.
+
+# 19-Mar-1992          Johan Vromans   
+#    Allow require from packages.
+#    NGetOpt is now defined in the package that requires it.
+#    @ARGV and $opt_... are taken from the package that calls it.
+#    Use standard (?) option prefixes: -, -- and +.
+
 # 20-Sep-1990          Johan Vromans   
 #    Set options w/o argument to 1.
 #    Correct the dreadful semicolon/require bug.
 
 
-package newgetopt;
+{   package newgetopt;
+    $debug = 0;                        # for debugging
+    $ignorecase = 1;           # ignore case when matching options
+}
+
+sub NGetOpt {
+
+    @newgetopt'optionlist = @_;
+    *newgetopt'ARGV = *ARGV;
 
-$debug = 0;                    # for debugging
+    package newgetopt;
 
-sub main'NGetOpt {
-    local (@optionlist) = @_;
     local ($[) = 0;
-    local ($genprefix) = "-";
+    local ($genprefix) = "(--|-|\\+)";
+    local ($argend) = "--";
     local ($error) = 0;
-    local ($opt, $optx, $arg, $type, $mand, @hits);
+    local ($opt, $optx, $arg, $type, $mand, %opctl);
+    local ($pkg) = (caller)[0];
+
+    print STDERR "NGetOpt 1.13 -- called from $pkg\n" if $debug;
 
     # See if the first element of the optionlist contains option
     # starter characters.
-    $genprefix = shift (@optionlist) if $optionlist[0] =~ /^\W+$/;
-
-    # Turn into regexp.
-    $genprefix =~ s/(\W)/\\\1/g;
-    $genprefix = "[" . $genprefix . "]";
+    if ( $optionlist[0] =~ /^\W+$/ ) {
+       $genprefix = shift (@optionlist);
+       # Turn into regexp.
+       $genprefix =~ s/(\W)/\\\1/g;
+       $genprefix = "[" . $genprefix . "]";
+       undef $argend;
+    }
 
     # Verify correctness of optionlist.
-    @hits = grep ($_ !~ /^\w+([=:][infse])?$/, @optionlist);
-    if ( $#hits >= 0 ) {
-       foreach $opt ( @hits ) {
+    %opctl = ();
+    foreach $opt ( @optionlist ) {
+       $opt =~ tr/A-Z/a-z/ if $ignorecase;
+       if ( $opt !~ /^(\w*)([=:][infse]@?)?$/ ) {
            print STDERR ("Error in option spec: \"", $opt, "\"\n");
            $error++;
+           next;
+       }
+       $opctl{$1} = defined $2 ? $2 : "";
+    }
+
+    return 0 if $error;
+
+    if ( $debug ) {
+       local ($arrow, $k, $v);
+       $arrow = "=> ";
+       while ( ($k,$v) = each(%opctl) ) {
+           print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
+           $arrow = "   ";
        }
-       return 0;
     }
 
     # Process argument list
 
-    while ( $#main'ARGV >= 0 ) {               #'){
+    while ( $#ARGV >= 0 ) {
 
        # >>> See also the continue block <<<
 
        # Get next argument
-       $opt = shift (@main'ARGV);              #');
+       $opt = shift (@ARGV);
        print STDERR ("=> option \"", $opt, "\"\n") if $debug;
        $arg = undef;
 
        # Check for exhausted list.
-       if ( $opt =~ /^$genprefix/o ) {
+       if ( $opt =~ /^$genprefix/ ) {
            # Double occurrence is terminator
-           return ($error == 0) if $opt eq "$+$+";
+           return ($error == 0) 
+               if ($opt eq "$+$+") || ((defined $argend) && $opt eq $argend);
            $opt = $';          # option name (w/o prefix)
        }
        else {
            # Apparently not an option - push back and exit.
-           unshift (@main'ARGV, $opt);         #');
+           unshift (@ARGV, $opt);
            return ($error == 0);
        }
 
-       # Grep in option list. Hide regexp chars from option.
-       ($optx = $opt) =~ s/(\W)/\\\1/g;
-       @hits = grep (/^$optx([=:].+)?$/, @optionlist);
-       if ( $#hits != 0 ) {
+       # Look it up.
+       $opt =~ tr/A-Z/a-z/ if $ignorecase;
+       unless  ( defined ( $type = $opctl{$opt} ) ) {
            print STDERR ("Unknown option: ", $opt, "\n");
            $error++;
            next;
        }
 
        # Determine argument status.
-       undef $type;
-       $type = $+ if $hits[0] =~ /[=:].+$/;
-       print STDERR ("=> found \"$hits[0]\" for ", $opt, "\n") if $debug;
+       print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
 
        # If it is an option w/o argument, we're almost finished with it.
-       if ( ! defined $type ) {
+       if ( $type eq "" ) {
            $arg = 1;           # supply explicit value
+           $array = 0;
            next;
        }
 
        # Get mandatory status and type info.
-       ($mand, $type) = $type =~ /^(.)(.)$/;
+       ($mand, $type, $array) = $type =~ /^(.)(.)(@?)$/;
 
        # Check if the argument list is exhausted.
-       if ( $#main'ARGV < 0 ) {                #'){
+       if ( $#ARGV < 0 ) {
 
            # Complain if this option needs an argument.
            if ( $mand eq "=" ) {
@@ -146,30 +193,35 @@ sub main'NGetOpt {
        }
 
        # Get (possibly optional) argument.
-       $arg = shift (@main'ARGV);              #');
+       $arg = shift (@ARGV);
 
        # Check if it is a valid argument. A mandatory string takes
-       # anything. 
-       if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/o ) {
+       # anything. 
+       if ( "$mand$type" ne "=s" && $arg =~ /^$genprefix/ ) {
 
            # Check for option list terminator.
-           if ( $arg eq "$+$+" ) {
+           if ( $arg eq "$+$+" || 
+                ((defined $argend) && $arg eq $argend)) {
+               # Push back so the outer loop will terminate.
+               unshift (@ARGV, $arg);
                # Complain if an argument is required.
                if ($mand eq "=") {
                    print STDERR ("Option ", $opt, " requires an argument\n");
                    $error++;
+                   undef $arg; # don't assign it
+               }
+               else {
+                   # Supply empty value.
+                   $arg = $type eq "s" ? "" : 0;
                }
-               # Push back so the outer loop will terminate.
-               unshift (@main'ARGV, $arg);     #');
-               $arg = "";      # don't assign it
                next;
            }
 
            # Maybe the optional argument is the next option?
-           if ( $mand eq ":" && $' =~ /[a-zA-Z_]/ ) {
+           if ( $mand eq ":" && ($' eq "" || $' =~ /[a-zA-Z_]/) ) {
                # Yep. Push back.
-               unshift (@main'ARGV, $arg);     #');
-               $arg = "";      # don't assign it
+               unshift (@ARGV, $arg);
+               $arg = $type eq "s" ? "" : 0;
                next;
            }
        }
@@ -177,8 +229,9 @@ sub main'NGetOpt {
        if ( $type eq "n" || $type eq "i" ) { # numeric/integer
            if ( $arg !~ /^-?[0-9]+$/ ) {
                print STDERR ("Value \"", $arg, "\" invalid for option ",
-                              $opt, " (numeric required)\n");
+                             $opt, " (number expected)\n");
                $error++;
+               undef $arg;     # don't assign it
            }
            next;
        }
@@ -186,8 +239,9 @@ sub main'NGetOpt {
        if ( $type eq "f" ) { # fixed real number, int is also ok
            if ( $arg !~ /^-?[0-9.]+$/ ) {
                print STDERR ("Value \"", $arg, "\" invalid for option ",
-                              $opt, " (real number required)\n");
+                             $opt, " (real number expected)\n");
                $error++;
+               undef $arg;     # don't assign it
            }
            next;
        }
@@ -198,8 +252,18 @@ sub main'NGetOpt {
 
     }
     continue {
-       print STDERR ("=> \$main'opt_$opt = $arg\n") if $debug;
-       eval ("\$main'opt_$opt = \$arg");
+       if ( defined $arg ) {
+           if ( $array ) {
+               print STDERR ('=> push (@', $pkg, '\'opt_', $opt, ", \"$arg\")\n")
+                   if $debug;
+               eval ('push(@' . $pkg . '\'opt_' . $opt . ", \$arg);");
+           }
+           else {
+               print STDERR ('=> $', $pkg, '\'opt_', $opt, " = \"$arg\"\n")
+                   if $debug;
+               eval ('$' . $pkg . '\'opt_' . $opt . " = \$arg;");
+           }
+       }
     }
 
     return ($error == 0);
diff --git a/lib/open2.pl b/lib/open2.pl
new file mode 100644 (file)
index 0000000..dcd68a8
--- /dev/null
@@ -0,0 +1,54 @@
+# &open2: tom christiansen, <tchrist@convex.com>
+#
+# usage: $pid = &open2('rdr', 'wtr', 'some cmd and args');
+#    or  $pid = &open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args');
+#
+# spawn the given $cmd and connect $rdr for
+# reading and $wtr for writing.  return pid
+# of child, or 0 on failure.  
+# 
+# WARNING: this is dangerous, as you may block forever
+# unless you are very careful.  
+# 
+# $wtr is left unbuffered.
+# 
+# abort program if
+#      rdr or wtr are null
+#      pipe or fork or exec fails
+
+package open2;
+$fh = 'FHOPEN000';  # package static in case called more than once
+
+sub main'open2 {
+    local($kidpid);
+    local($dad_rdr, $dad_wtr, @cmd) = @_;
+
+    $dad_rdr ne ''             || die "open2: rdr should not be null";
+    $dad_wtr ne ''             || die "open2: wtr should not be null";
+
+    # force unqualified filehandles into callers' package
+    local($package) = caller;
+    $dad_rdr =~ s/^[^']+$/$package'$&/;
+    $dad_wtr =~ s/^[^']+$/$package'$&/;
+
+    local($kid_rdr) = ++$fh;
+    local($kid_wtr) = ++$fh;
+
+    pipe($dad_rdr, $kid_wtr)   || die "open2: pipe 1 failed: $!";
+    pipe($kid_rdr, $dad_wtr)   || die "open2: pipe 2 failed: $!";
+
+    if (($kidpid = fork) < 0) {
+       die "open2: fork failed: $!";
+    } elsif ($kidpid == 0) {
+       close $dad_rdr; close $dad_wtr;
+       open(STDIN,  "<&$kid_rdr");
+       open(STDOUT, ">&$kid_wtr");
+       warn "execing @cmd\n" if $debug;
+       exec @cmd;
+       die "open2: exec of @cmd failed";   
+    } 
+    close $kid_rdr; close $kid_wtr;
+    select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe
+    $kidpid;
+}
+1; # so require is happy
index 2a8b551..276e3db 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -1,6 +1,11 @@
-/* $RCSfile: malloc.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:57:40 $
+/* $RCSfile: malloc.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 14:28:38 $
  *
  * $Log:       malloc.c,v $
+ * Revision 4.0.1.4  92/06/08  14:28:38  lwall
+ * patch20: removed implicit int declarations on functions
+ * patch20: hash tables now split only if the memory is available to do so
+ * patch20: realloc(0, size) now does malloc in case library routines call it
+ * 
  * Revision 4.0.1.3  91/11/05  17:57:40  lwall
  * patch11: safe malloc code now integrated into Perl's malloc when possible
  * 
@@ -102,7 +107,7 @@ static      u_int nmalloc[NBUCKETS];
 
 #ifdef debug
 #define        ASSERT(p)   if (!(p)) botch("p"); else
-static
+static void
 botch(s)
        char *s;
 {
@@ -120,20 +125,20 @@ static int an = 0;
 
 MALLOCPTRTYPE *
 malloc(nbytes)
-       register unsigned nbytes;
+       register MEM_SIZE nbytes;
 {
        register union overhead *p;
        register int bucket = 0;
-       register unsigned shiftr;
+       register MEM_SIZE shiftr;
 
 #ifdef safemalloc
 #ifdef DEBUGGING
-       int size = nbytes;
+       MEM_SIZE size = nbytes;
 #endif
 
 #ifdef MSDOS
        if (nbytes > 0xffff) {
-               fprintf(stderr, "Allocation too large: %lx\n", nbytes);
+               fprintf(stderr, "Allocation too large: %lx\n", (long)nbytes);
                exit(1);
        }
 #endif /* MSDOS */
@@ -163,8 +168,10 @@ malloc(nbytes)
                morecore(bucket);
        if ((p = (union overhead *)nextf[bucket]) == NULL) {
 #ifdef safemalloc
-               fputs("Out of memory!\n", stderr);
-               exit(1);
+               if (!nomemok) {
+                   fputs("Out of memory!\n", stderr);
+                   exit(1);
+               }
 #else
                return (NULL);
 #endif
@@ -172,12 +179,12 @@ malloc(nbytes)
 
 #ifdef safemalloc
 #ifdef DEBUGGING
-#  ifndef I286
+#  if !(defined(I286) || defined(atarist))
     if (debug & 128)
-        fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",p+1,an++,size);
+        fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
 #  else
     if (debug & 128)
-        fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",p+1,an++,size);
+        fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",p+1,an++,(long)size);
 #  endif
 #endif
 #endif /* safemalloc */
@@ -185,7 +192,7 @@ malloc(nbytes)
        /* remove from linked list */
 #ifdef RCHECK
        if (*((int*)p) & (sizeof(union overhead) - 1))
-#ifndef I286
+#if !(defined(I286) || defined(atarist))
            fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
 #else
            fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
@@ -220,7 +227,7 @@ morecore(bucket)
        register union overhead *op;
        register int rnu;       /* 2^rnu bytes will be requested */
        register int nblks;     /* become nblks blocks of the desired size */
-       register int siz;
+       register MEM_SIZE siz;
 
        if (nextf[bucket])
                return;
@@ -229,6 +236,7 @@ morecore(bucket)
         * on a page boundary.  Should
         * make getpageize call?
         */
+#ifndef atarist /* on the atari we dont have to worry about this */
        op = (union overhead *)sbrk(0);
 #ifndef I286
        if ((int)op & 0x3ff)
@@ -236,19 +244,20 @@ morecore(bucket)
 #else
        /* The sbrk(0) call on the I286 always returns the next segment */
 #endif
+#endif /* atarist */
 
-#ifndef I286
+#if !(defined(I286) || defined(atarist))
        /* take 2k unless the block is bigger than that */
        rnu = (bucket <= 8) ? 11 : bucket + 3;
 #else
        /* take 16k unless the block is bigger than that 
-          (80286s like large segments!)                */
+          (80286s like large segments!), probably good on the atari too */
        rnu = (bucket <= 11) ? 14 : bucket + 3;
 #endif
        nblks = 1 << (rnu - (bucket + 3));  /* how many blocks to get */
        if (rnu < bucket)
                rnu = bucket;
-       op = (union overhead *)sbrk(1 << rnu);
+       op = (union overhead *)sbrk(1L << rnu);
        /* no more room! */
        if ((int)op == -1)
                return;
@@ -258,7 +267,7 @@ morecore(bucket)
         */
 #ifndef I286
        if ((int)op & 7) {
-               op = (union overhead *)(((int)op + 8) &~ 7);
+               op = (union overhead *)(((MEM_SIZE)op + 8) &~ 7);
                nblks--;
        }
 #else
@@ -280,13 +289,13 @@ void
 free(mp)
        MALLOCPTRTYPE *mp;
 {   
-       register int size;
+       register MEM_SIZE size;
        register union overhead *op;
        char *cp = (char*)mp;
 
 #ifdef safemalloc
 #ifdef DEBUGGING
-#  ifndef I286
+#  if !(defined(I286) || defined(atarist))
        if (debug & 128)
                fprintf(stderr,"0x%x: (%05d) free\n",cp,an++);
 #  else
@@ -339,9 +348,9 @@ int reall_srchlen = 4;      /* 4 should be plenty, -1 =>'s whole list */
 MALLOCPTRTYPE *
 realloc(mp, nbytes)
        MALLOCPTRTYPE *mp; 
-       unsigned nbytes;
+       MEM_SIZE nbytes;
 {   
-       register u_int onb;
+       register MEM_SIZE onb;
        union overhead *op;
        char *res;
        register int i;
@@ -350,7 +359,7 @@ realloc(mp, nbytes)
 
 #ifdef safemalloc
 #ifdef DEBUGGING
-       int size = nbytes;
+       MEM_SIZE size = nbytes;
 #endif
 
 #ifdef MSDOS
@@ -360,15 +369,13 @@ realloc(mp, nbytes)
        }
 #endif /* MSDOS */
        if (!cp)
-               fatal("Null realloc");
+               return malloc(nbytes);
 #ifdef DEBUGGING
        if ((long)nbytes < 0)
                fatal("panic: realloc");
 #endif
 #endif /* safemalloc */
 
-       if (cp == NULL)
-               return (malloc(nbytes));
        op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
        if (op->ov_magic == MAGIC) {
                was_alloced++;
@@ -389,7 +396,7 @@ realloc(mp, nbytes)
                    (i = findbucket(op, reall_srchlen)) < 0)
                        i = 0;
        }
-       onb = (1 << (i + 3)) - sizeof (*op) - RSLOP;
+       onb = (1L << (i + 3)) - sizeof (*op) - RSLOP;
        /* avoid the copy if same size block */
        if (was_alloced &&
            nbytes <= onb && nbytes > (onb >> 1) - sizeof(*op) - RSLOP) {
@@ -417,22 +424,22 @@ realloc(mp, nbytes)
                if ((res = (char*)malloc(nbytes)) == NULL)
                        return (NULL);
                if (cp != res)                  /* common optimization */
-                       bcopy(cp, res, (int)(nbytes < onb ? nbytes : onb));
+                       Copy(cp, res, (MEM_SIZE)(nbytes<onb?nbytes:onb), char);
                if (was_alloced)
                        free(cp);
        }
 
 #ifdef safemalloc
 #ifdef DEBUGGING
-#  ifndef I286
+#  if !(defined(I286) || defined(atarist))
        if (debug & 128) {
            fprintf(stderr,"0x%x: (%05d) rfree\n",res,an++);
-           fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",res,an++,size);
+           fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",res,an++,(long)size);
        }
 #  else
        if (debug & 128) {
            fprintf(stderr,"0x%lx: (%05d) rfree\n",res,an++);
-           fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",res,an++,size);
+           fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",res,an++,(long)size);
        }
 #  endif
 #endif
@@ -445,7 +452,7 @@ realloc(mp, nbytes)
  * header starts at ``freep''.  If srchlen is -1 search the whole list.
  * Return bucket number, or -1 if not found.
  */
-static
+static int
 findbucket(freep, srchlen)
        union overhead *freep;
        int srchlen;
@@ -472,6 +479,7 @@ findbucket(freep, srchlen)
  * for each size category, the second showing the number of mallocs -
  * frees for each size category.
  */
+void
 mstats(s)
        char *s;
 {
index bd31a24..ee22262 100644 (file)
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -1,4 +1,4 @@
-/* $RCSfile: os2.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:23:06 $
+/* $RCSfile: os2.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 14:32:30 $
  *
  *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       os2.c,v $
+ * Revision 4.0.1.2  92/06/08  14:32:30  lwall
+ * patch20: new OS/2 support
+ * 
  * Revision 4.0.1.1  91/06/07  11:23:06  lwall
  * patch4: new copyright notice
  * 
@@ -54,14 +57,15 @@ int syscall()
 { return -1; }
 
 
-/* extendd chdir() */
+/* extended chdir() */
 
 int chdir(char *path)
 {
   if ( path[0] != 0 && path[1] == ':' )
-    DosSelectDisk(toupper(path[0]) - '@');
+    if ( DosSelectDisk(toupper(path[0]) - '@') )
+      return -1;
 
-  DosChDir(path, 0L);
+  return DosChDir(path, 0L);
 }
 
 
@@ -102,6 +106,17 @@ int getppid(void)
 }
 
 
+/* wait for specific pid */
+int wait4pid(int pid, int *status, int flags)
+{
+  RESULTCODES res;
+  int endpid, rc;
+  if ( DosCwait(DCWA_PROCESS, flags ? DCWW_NOWAIT : DCWW_WAIT,
+                &res, &endpid, pid) )
+    return -1;
+  *status = res.codeResult;
+  return endpid;
+}
 /* kill */
 
 int kill(int pid, int sig)
@@ -251,7 +266,7 @@ char *cmd;
 usage(char *myname)
 {
 #ifdef MSDOS
-  printf("\nUsage: %s [-acdnpsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
+  printf("\nUsage: %s [-acdnpPsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
 #else
   printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
 #endif
@@ -262,9 +277,7 @@ usage(char *myname)
          "\n  -d  run scripts under debugger"
          "\n  -n  assume 'while (<>) { ...script... }' loop arround your script"
          "\n  -p  assume loop like -n but print line also like sed"
-#ifndef MSDOS
          "\n  -P  run script through C preprocessor befor compilation"
-#endif
          "\n  -s  enable some switch parsing for switches after script name"
          "\n  -S  look for the script using PATH environment variable");
 #ifndef MSDOS
index 73bc4d7..000d2c0 100644 (file)
@@ -1,15 +1,18 @@
 (-W1 -Od -Olt -DDEBUGGING -Gt2048
 array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
-hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
+hash.c perl.c regcomp.c regexec.c stab.c str.c util.c
 )
-(-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
+(-W1 -Od -Olt -DDEBUGGING -Gt2048 (-d perly.y))
+(-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c toke.c)
 (-W1 -Od -Olt -I. -Ios2
-os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c os2\alarm.c
+os2\os2.c os2\popen.c os2\suffix.c
+os2\director.c os2\alarm.c os2\crypt.c
 )
 
 ; link with this library if you have GNU gdbm for OS/2
-; remember to enable the NDBM symbol in config.h before compiling
-lgdbm.lib
+; remember to enable the GDBM symbol in config.h before compiling
+llibgdbm.lib
+
 setargv.obj
 os2\perl.def
 os2\perl.bad
index c19e340..7c0fca0 100644 (file)
@@ -1,2 +1,2 @@
-NAME PERL WINDOWCOMPAT NEWFILES
-DESCRIPTION 'PERL 3.0 - for MS-DOS and OS/2'
+NAME WINDOWCOMPAT NEWFILES
+DESCRIPTION 'PERL 4.0 - for MS-DOS and OS/2'
index a171682..e69de29 100644 (file)
@@ -1,52 +0,0 @@
-*** lib/perldb.pl      Tue Oct 23 23:14:20 1990
---- os2/perldb.pl      Tue Nov 06 21:13:42 1990
-***************
-*** 36,43 ****
-  #
-  #
-
-! open(IN, "</dev/tty") || open(IN,  "<&STDIN");       # so we don't dingle stdin
-! open(OUT,">/dev/tty") || open(OUT, ">&STDOUT");      # so we don't dongle stdout
-  select(OUT);
-  $| = 1;                              # for DB'OUT
-  select(STDOUT);
---- 36,43 ----
-  #
-  #
-
-! open(IN, "<con") || open(IN,  "<&STDIN");    # so we don't dingle stdin
-! open(OUT,">con") || open(OUT, ">&STDOUT");   # so we don't dongle stdout
-  select(OUT);
-  $| = 1;                              # for DB'OUT
-  select(STDOUT);
-***************
-*** 517,530 ****
-      s/(.*)/'$1'/ unless /^-?[\d.]+$/;
-  }
-
-! if (-f '.perldb') {
-!     do './.perldb';
-  }
-! elsif (-f "$ENV{'LOGDIR'}/.perldb") {
-!     do "$ENV{'LOGDIR'}/.perldb";
-  }
-! elsif (-f "$ENV{'HOME'}/.perldb") {
-!     do "$ENV{'HOME'}/.perldb";
-  }
-
-  1;
---- 517,530 ----
-      s/(.*)/'$1'/ unless /^-?[\d.]+$/;
-  }
-
-! if (-f 'perldb.ini') {
-!     do './perldb.ini';
-  }
-! elsif (-f "$ENV{'INIT'}/perldb.ini") {
-!     do "$ENV{'INIT'}/perldb.ini";
-  }
-! elsif (-f "$ENV{'HOME'}/perldb.ini") {
-!     do "$ENV{'HOME'}/perldb.ini";
-  }
-
-  1;
index 5f4efc8..a14bc63 100644 (file)
@@ -1 +1 @@
-DOSQFSATTACH
+(deprecated)
index 466db5f..afbe4bd 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 27
+#define PATCHLEVEL 28
diff --git a/perl.h b/perl.h
index c9064b1..5d9f002 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $RCSfile: perl.h,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:41:07 $
+/* $RCSfile: perl.h,v $$Revision: 4.0.1.6 $$Date: 92/06/08 14:55:10 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,12 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       perl.h,v $
+ * Revision 4.0.1.6  92/06/08  14:55:10  lwall
+ * patch20: added Atari ST portability
+ * patch20: bcopy() and memcpy() now tested for overlap safety
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: removed implicit int declarations on functions
+ * 
  * Revision 4.0.1.5  91/11/11  16:41:07  lwall
  * patch19: uts wrongly defines S_ISDIR() et al
  * patch19: too many preprocessors can't expand a macro right in #if
 char Error[1];
 #endif
 
-#ifdef MSDOS
+/* define this once if either system, instead of cluttering up the src */
+#if defined(MSDOS) || defined(atarist)
+#define DOSISH 1
+#endif
+
+#ifdef DOSISH
 /* This stuff now in the MS-DOS config.h file. */
 #else /* !MSDOS */
 
@@ -130,33 +141,77 @@ char Error[1];
 /* Use all the "standard" definitions */
 #include <stdlib.h>
 #include <string.h>
+#define MEM_SIZE size_t
+#else
+typedef unsigned int MEM_SIZE;
 #endif /* STANDARD_C */
 
-#if defined(HAS_MEMCMP) && defined(mips) && BYTEORDER == 0x1234
+#if defined(HAS_MEMCMP) && defined(mips) && defined(ultrix)
 #undef HAS_MEMCMP
 #endif
 
 #ifdef HAS_MEMCPY
-
 #  ifndef STANDARD_C
 #    ifndef memcpy
-extern char * memcpy(), *memset();
-extern int memcmp();
-#    endif /* ndef memcpy */
-#  endif /* ndef STANDARD_C */
+       extern char * memcpy();
+#    endif
+#  endif
+#else
+#   ifndef memcpy
+#      ifdef HAS_BCOPY
+#          define memcpy(d,s,l) bcopy(s,d,l)
+#      else
+#          define memcpy(d,s,l) my_bcopy(s,d,l)
+#      endif
+#   endif
+#endif /* HAS_MEMCPY */
 
-#   ifndef bcopy
-#      define bcopy(s1,s2,l) memcpy(s2,s1,l)
+#ifdef HAS_MEMSET
+#  ifndef STANDARD_C
+#    ifndef memset
+       extern char *memset();
+#    endif
+#  endif
+#  define memzero(d,l) memset(d,0,l)
+#else
+#   ifndef memzero
+#      ifdef HAS_BZERO
+#          define memzero(d,l) bzero(d,l)
+#      else
+#          define memzero(d,l) my_bzero(d,l)
+#      endif
 #   endif
-#   ifndef bzero
-#      define bzero(s,l) memset(s,0,l)
+#endif /* HAS_MEMSET */
+
+#ifdef HAS_MEMCMP
+#  ifndef STANDARD_C
+#    ifndef memcmp
+       extern int memcmp();
+#    endif
+#  endif
+#else
+#   ifndef memcmp
+#      define memcmp(s1,s2,l) my_memcmp(s1,s2,l)
 #   endif
-#endif /* HAS_MEMCPY */
+#endif /* HAS_MEMCMP */
 
-#ifndef HAS_BCMP               /* prefer bcmp slightly 'cuz it doesn't order */
+/* we prefer bcmp slightly for comparisons that don't care about ordering */
+#ifndef HAS_BCMP
 #   ifndef bcmp
 #      define bcmp(s1,s2,l) memcmp(s1,s2,l)
 #   endif
+#endif /* HAS_BCMP */
+
+#ifndef HAS_MEMMOVE
+#if defined(HAS_BCOPY) && defined(SAFE_BCOPY)
+#define memmove(d,s,l) bcopy(s,d,l)
+#else
+#if defined(HAS_MEMCPY) && defined(SAFE_MEMCPY)
+#define memmove(d,s,l) memcpy(d,s,l)
+#else
+#define memmove(d,s,l) my_bcopy(s,d,l)
+#endif
+#endif
 #endif
 
 #ifndef _TYPES_                /* If types.h defines this it's easy. */
@@ -170,7 +225,7 @@ extern int memcmp();
 #endif
 
 #include <sys/stat.h>
-#ifdef uts
+#if defined(uts) || defined(UTekV)
 #undef S_ISDIR
 #undef S_ISCHR
 #undef S_ISBLK
@@ -182,8 +237,10 @@ extern int memcmp();
 #define S_ISBLK(P) (((P)&S_IFMT)==S_IFBLK)
 #define S_ISREG(P) (((P)&S_IFMT)==S_IFREG)
 #define S_ISFIFO(P) (((P)&S_IFMT)==S_IFIFO)
+#ifdef S_IFLNK
 #define S_ISLNK(P) (((P)&S_IFMT)==S_IFLNK)
 #endif
+#endif
 
 #ifdef I_TIME
 #   include <time.h>
@@ -230,7 +287,7 @@ extern char *sys_errlist[];
 #endif
 #endif
 
-#if defined(mc300) || defined(mc500) || defined(mc700) /* MASSCOMP */
+#if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
 #ifdef HAS_SOCKETPAIR
 #undef HAS_SOCKETPAIR
 #endif
@@ -437,7 +494,7 @@ EXT int dbmlen;
 #undef f_next
 #endif
 
-#if defined(cray) || defined(gould)
+#if defined(cray) || defined(gould) || defined(i860)
 #   define SLOPPYDIVIDE
 #endif
 
@@ -457,7 +514,7 @@ EXT int dbmlen;
 #   endif
 #endif
 
-typedef unsigned int STRLEN;
+typedef MEM_SIZE STRLEN;
 
 typedef struct arg ARG;
 typedef struct cmd CMD;
@@ -553,7 +610,7 @@ EXT STR *Str;
 
 #define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
 
-#ifndef MSDOS
+#ifndef DOSISH
 #define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
 #define Str_Grow str_grow
 #else
@@ -561,7 +618,7 @@ EXT STR *Str;
 #define STR_GROW(str,len) if ((str)->str_len < (unsigned long)len) \
                str_grow(str,(unsigned long)len)
 #define Str_Grow(str,len) str_grow(str,(unsigned long)(len))
-#endif /* MSDOS */
+#endif /* DOSISH */
 
 #ifndef BYTEORDER
 #define BYTEORDER 0x1234
@@ -670,6 +727,7 @@ ARG *cval_to_arg();
 STR *str_new();
 STR *stab_str();
 
+int apply();
 int do_each();
 int do_subr();
 int do_match();
@@ -701,12 +759,24 @@ bool do_aexec();
 int do_subst();
 int cando();
 int ingroup();
+int whichsig();
+int userinit();
+#ifdef CRYPTSCRIPT
+void cryptswitch();
+#endif
 
 void str_replace();
 void str_inc();
 void str_dec();
 void str_free();
+void cmd_free();
+void arg_free();
+void spat_free();
+void regfree();
 void stab_clear();
+void do_chop();
+void do_vop();
+void do_write();
 void do_join();
 void do_sprintf();
 void do_accept();
@@ -724,6 +794,24 @@ void savesptr();
 void savehptr();
 void restorelist();
 void repeatcpy();
+void make_form();
+void dehoist();
+void format();
+void my_unexec();
+void fatal();
+void warn();
+#ifdef DEBUGGING
+void dump_all();
+void dump_cmd();
+void dump_arg();
+void dump_flags();
+void dump_stab();
+void dump_spat();
+#endif
+#ifdef MSTATS
+void mstats();
+#endif
+
 HASH *savehash();
 ARRAY *saveary();
 
@@ -773,6 +861,7 @@ EXT STR *lastretstr INIT(Nullstr);
 EXT STR *DBsingle INIT(Nullstr);
 EXT STR *DBtrace INIT(Nullstr);
 EXT STR *DBsignal INIT(Nullstr);
+EXT STR *formfeed INIT(Nullstr);
 
 EXT int lastspbase;
 EXT int lastsize;
@@ -791,6 +880,7 @@ EXT STR *linestr INIT(Nullstr);
 EXT char *rs INIT("\n");
 EXT int rschar INIT('\n');     /* final char of rs, or 0777 if none */
 EXT int rslen INIT(1);
+EXT bool rspara INIT(FALSE);
 EXT char *ofs INIT(Nullch);
 EXT int ofslen INIT(0);
 EXT char *ors INIT(Nullch);
@@ -820,15 +910,18 @@ EXT bool localizing INIT(FALSE);  /* are we processing a local() list? */
 EXT int maxsysfd INIT(MAXSYSFD);       /* top fd to pass to subprocesses */
 
 #ifdef CSH
-char *cshname INIT(CSH);
-int cshlen INIT(0);
+EXT char *cshname INIT(CSH);
+EXT int cshlen INIT(0);
 #endif /* CSH */
 
 #ifdef TAINT
 EXT bool tainted INIT(FALSE);          /* using variables controlled by $< */
+EXT bool taintanyway INIT(FALSE);      /* force taint checks when !set?id */
 #endif
 
-#ifndef MSDOS
+EXT bool nomemok INIT(FALSE);          /* let malloc context handle nomem */
+
+#ifndef DOSISH
 #define TMPPATH "/tmp/perl-eXXXXXX"
 #else
 #define TMPPATH "plXXXXXX"
@@ -858,8 +951,8 @@ void scanconst();
 
 EXT struct stat statbuf;
 EXT struct stat statcache;
-STAB *statstab INIT(Nullstab);
-STR *statname;
+EXT STAB *statstab INIT(Nullstab);
+EXT STR *statname;
 #ifndef MSDOS
 EXT struct tms timesbuf;
 #endif
@@ -928,7 +1021,7 @@ EXT char *dc;
 EXT short *ds;
 
 /* Fix these up for __STDC__ */
-EXT long basetime INIT(0);
+EXT time_t basetime INIT(0);
 char *mktemp();
 #ifndef STANDARD_C
 /* All of these are in stdlib.h or time.h for ANSI C */
@@ -958,3 +1051,7 @@ int unlnk();
 #define HAS_SETREGID
 #endif
 #endif
+
+#define SCAN_DEF 0
+#define SCAN_TR 1
+#define SCAN_REPL 2