perl 3.0 patch #33 patch #29, continued
Larry Wall [Mon, 15 Oct 1990 23:03:11 +0000 (23:03 +0000)]
See patch #29.

lib/perldb.pl
os2/perlglob.cs [new file with mode: 0644]
os2/perlglob.def [new file with mode: 0644]
os2/perlsh.cmd [new file with mode: 0644]
patchlevel.h
perl.man.1
perl.man.2
perl.man.3
perl.man.4
stab.h

index c84b6ac..cff7cb3 100644 (file)
@@ -1,6 +1,6 @@
 package DB;
 
-$header = '$Header: perldb.pl,v 3.0.1.3 90/08/09 04:00:58 lwall Locked $';
+$header = '$Header: perldb.pl,v 3.0.1.4 90/10/15 17:40:38 lwall Locked $';
 #
 # This file is automatically included if you do perl -d.
 # It's probably not useful to include this yourself.
@@ -10,6 +10,12 @@ $header = '$Header: perldb.pl,v 3.0.1.3 90/08/09 04:00:58 lwall Locked $';
 # have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
 #
 # $Log:        perldb.pl,v $
+# Revision 3.0.1.4  90/10/15  17:40:38  lwall
+# patch29: added caller
+# patch29: the debugger now understands packages and evals
+# patch29: scripts now run at almost full speed under the debugger
+# patch29: more variables are settable from debugger
+# 
 # Revision 3.0.1.3  90/08/09  04:00:58  lwall
 # patch19: debugger now allows continuation lines
 # patch19: debugger can now dump lists of variables
@@ -30,57 +36,55 @@ $header = '$Header: perldb.pl,v 3.0.1.3 90/08/09 04:00:58 lwall Locked $';
 # 
 #
 
-open(IN,"/dev/tty");           # so we don't dingle stdin
-open(OUT,">/dev/tty"); # so we don't dongle stdout
+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);
 $| = 1;                                # for real STDOUT
+$sub = '';
 
 $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/;
-print OUT "\nLoading custom DB from $header\n\nEnter h for help.\n\n";
+print OUT "\nLoading DB routines from $header\n\nEnter h for help.\n\n";
 
 sub DB {
-    local($. ,$@, $!, $[, $,, $/, $\);
-    $[ = 0; $, = ""; $/ = "\n"; $\ = "";
-    ($line) = @_;
-    if ($stop[$line]) {
+    &save;
+    ($package, $filename, $line) = caller;
+    $usercontext = '($@, $!, $[, $,, $/, $\) = @saved;' .
+       "package $package;";            # this won't let them modify, alas
+    local(*dbline) = "_<$filename";
+    $max = $#dbline;
+    if (($stop,$action) = split(/\0/,$dbline{$line})) {
        if ($stop eq '1') {
            $signal |= 1;
        }
        else {
-           package main;
-           $DB'signal |= eval $DB'stop[$DB'line];  print DB'OUT $@;
-           $DB'stop[$DB'line] =~ s/;9$//;
+           $signal |= &eval($stop);
+           $dbline{$line} =~ s/;9($|\0)/$1/;
        }
     }
     if ($single || $trace || $signal) {
-       print OUT "$sub($line):\t",$line[$line];
-       for ($i = $line + 1; $i <= $max && $line[$i] == 0; ++$i) {
-           last if $line[$i] =~ /^\s*(}|#|\n)/;
-           print OUT "$sub($i):\t",$line[$i];
+       print OUT "$package'" unless $sub =~ /'/;
+       print OUT "$sub($filename:$line):\t",$dbline[$line];
+       for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
+           last if $dbline[$i] =~ /^\s*(}|#|\n)/;
+           print OUT "$sub($filename:$i):\t",$dbline[$i];
        }
     }
-    if ($action[$line]) {
-       package main;
-       eval $DB'action[$DB'line];  print DB'OUT $@;
-    }
+    &eval($action) if $action;
     if ($single || $signal) {
-       if ($pre) {
-           package main;
-           eval $DB'pre;  print DB'OUT $@;
-       }
+       &eval($pre) if $pre;
        print OUT $#stack . " levels deep in subroutine calls!\n"
            if $single & 4;
        $start = $line;
-       while ((print OUT "  DB<", $#hist+1, "> "), $cmd=<IN>) {
+       while ((print OUT "  DB<", $#hist+1, "> "), $cmd=&gets) {
            $single = 0;
            $signal = 0;
            $cmd eq '' && exit 0;
            chop($cmd);
            $cmd =~ s/\\$// && do {
                print OUT "  cont: ";
-               $cmd .= <IN>;
+               $cmd .= &gets;
                redo;
            };
            $cmd =~ /^q$/ && exit 0;
@@ -93,7 +97,7 @@ sub DB {
 T              Stack trace.
 s              Single step.
 n              Next, steps over subroutine calls.
-f              Finish current subroutine.
+r              Return from current subroutine.
 c [line]       Continue; optionally inserts a one-time-only breakpoint 
                at the specified line.
 <CR>           Repeat last n or s.
@@ -104,6 +108,7 @@ l           List next window.
 -              List previous window.
 w line         List window around line.
 l subname      List subroutine.
+f filename     Switch to filename.
 /pattern/      Search forwards for pattern; final / is optional.
 ?pattern?      Search backwards for pattern.
 L              List breakpoints and actions.
@@ -121,17 +126,17 @@ a [line] command
                Sequence is: check for breakpoint, print line if necessary,
                do action, prompt user if breakpoint or step, evaluate line.
 A              Delete all actions.
-V [pkg [vars]] List some (default all) variables in a package (default main).
-X [vars]       Same as \"V main [vars]\".
+V [pkg [vars]] List some (default all) variables in package (default current).
+X [vars]       Same as \"V currentpackage [vars]\".
 < command      Define command before prompt.
 > command      Define command after prompt.
 ! number       Redo command (default previous command).
 ! -number      Redo number\'th to last command.
 H -number      Display last number commands (default all).
 q or ^D                Quit.
-p expr         Same as \"package main; print DB'OUT expr\".
+p expr         Same as \"print DB'OUT expr\" in current package.
 = [alias value]        Define a command alias, or list current aliases.
-command                Execute as a perl statement.
+command                Execute as a perl statement in current package.
 
 ";
                next; };
@@ -141,18 +146,13 @@ command           Execute as a perl statement.
                next; };
            $cmd =~ /^S$/ && do {
                foreach $subname (sort(keys %sub)) {
-                   if ($subname =~ /^main'(.*)/) {
-                       print OUT $1,"\n";
-                   }
-                   else {
-                       print OUT $subname,"\n";
-                   }
+                   print OUT $subname,"\n";
                }
                next; };
-           $cmd =~ s/^X\b/V main/;
+           $cmd =~ s/^X\b/V $package/;
            $cmd =~ /^V$/ && do {
-               $cmd = 'V main'; };
-               $cmd =~ /^V\s*(\S+)\s*(.*)/ && do {
+               $cmd = 'V $package'; };
+           $cmd =~ /^V\s*(\S+)\s*(.*)/ && do {
                $packname = $1;
                @vars = split(' ',$2);
                do 'dumpvar.pl' unless defined &main'dumpvar;
@@ -163,10 +163,40 @@ command           Execute as a perl statement.
                    print DB'OUT "dumpvar.pl not available.\n";
                }
                next; };
+           $cmd =~ /^f\s*(.*)/ && do {
+               $file = $1;
+               if (!$file) {
+                   print OUT "The old f command is now the r command.\n";
+                   print OUT "The new f command switches filenames.\n";
+                   next;
+               }
+               if (!defined $_main{'_<' . $file}) {
+                   if (($try) = grep(m#^_<.*$file#, keys %_main)) {
+                       $file = substr($try,2);
+                       print "\n$file:\n";
+                   }
+               }
+               if (!defined $_main{'_<' . $file}) {
+                   print OUT "There's no code here anything matching $file.\n";
+                   next;
+               }
+               elsif ($file ne $filename) {
+                   *dbline = "_<$file";
+                   $max = $#dbline;
+                   $filename = $file;
+                   $start = 1;
+                   $cmd = "l";
+               } };
            $cmd =~ /^l\s*(['A-Za-z_]['\w]*)/ && do {
                $subname = $1;
                $subname = "main'" . $subname unless $subname =~ /'/;
-               $subrange = $sub{$subname};
+               $subname = "main" . $subname if substr($subname,0,1) eq "'";
+               ($file,$subrange) = split(/:/,$sub{$subname});
+               if ($file ne $filename) {
+                   *dbline = "_<$file";
+                   $max = $#dbline;
+                   $filename = $file;
+               }
                if ($subrange) {
                    if (eval($subrange) < -$window) {
                        $subrange =~ s/-.*/+/;
@@ -199,7 +229,7 @@ command             Execute as a perl statement.
                $i = $line if $i eq '.';
                $i = 1 if $i < 1;
                for (; $i <= $end; $i++) {
-                   print OUT "$i:\t", $line[$i];
+                   print OUT "$i:\t", $dbline[$i];
                    last if $signal;
                }
                $start = $i;    # remember in case they want more
@@ -208,47 +238,61 @@ command           Execute as a perl statement.
            $cmd =~ /^D$/ && do {
                print OUT "Deleting all breakpoints...\n";
                for ($i = 1; $i <= $max ; $i++) {
-                   $stop[$i] = 0;
+                   if (defined $dbline{$i}) {
+                       $dbline{$i} =~ s/^[^\0]+//;
+                       if ($dbline{$i} =~ s/^\0?$//) {
+                           delete $dbline{$i};
+                       }
+                   }
                }
                next; };
            $cmd =~ /^L$/ && do {
                for ($i = 1; $i <= $max; $i++) {
-                   if ($stop[$i] || $action[$i]) {
-                       print OUT "$i:\t", $line[$i];
-                       print OUT "  break if (", $stop[$i], ")\n" 
-                           if $stop[$i];
-                       print OUT "  action:  ", $action[$i], "\n" 
-                           if $action[$i];
+                   if (defined $dbline{$i}) {
+                       print OUT "$i:\t", $dbline[$i];
+                       ($stop,$action) = split(/\0/, $dbline{$i});
+                       print OUT "  break if (", $stop, ")\n" 
+                           if $stop;
+                       print OUT "  action:  ", $action, "\n" 
+                           if $action;
                        last if $signal;
                    }
                }
                next; };
            $cmd =~ /^b\s*(['A-Za-z_]['\w]*)\s*(.*)/ && do {
                $subname = $1;
-               $subname = "main'" . $subname unless $subname =~ /'/;
-               ($i) = split(/-/, $sub{$subname});
+               $cond = $2 || '1';
+               $subname = "$package'" . $subname unless $subname =~ /'/;
+               $subname = "main" . $subname if substr($subname,0,1) eq "'";
+               ($filename,$i) = split(/[:-]/, $sub{$subname});
                if ($i) {
-                   ++$i while $line[$i] == 0 && $i < $#line;
-                   $stop[$i] = $2 ? $2 : 1;
+                   *dbline = "_<$filename";
+                   ++$i while $dbline[$i] == 0 && $i < $#dbline;
+                   $dbline{$i} =~ s/^[^\0]*/$cond/;
                } else {
-                   print OUT "Subroutine $1 not found.\n";
+                   print OUT "Subroutine $subname not found.\n";
                }
                next; };
            $cmd =~ /^b\s*(\d*)\s*(.*)/ && do {
                $i = ($1?$1:$line);
-               if ($line[$i] == 0) {
+               $cond = $2 || '1';
+               if ($dbline[$i] == 0) {
                    print OUT "Line $i not breakable.\n";
                } else {
-                   $stop[$i] = $2 ? $2 : 1;
+                   $dbline{$i} =~ s/^[^\0]*/$cond/;
                }
                next; };
            $cmd =~ /^d\s*(\d+)?/ && do {
                $i = ($1?$1:$line);
-               $stop[$i] = '';
+               $dbline{$i} =~ s/^[^\0]*//;
+               delete $dbline{$i} if $dbline{$i} eq '';
                next; };
            $cmd =~ /^A$/ && do {
                for ($i = 1; $i <= $max ; $i++) {
-                   $action[$i] = '';
+                   if (defined $dbline{$i}) {
+                       $dbline{$i} =~ s/\0[^\0]*//;
+                       delete $dbline{$i} if $dbline{$i} eq '';
+                   }
                }
                next; };
            $cmd =~ /^<\s*(.*)/ && do {
@@ -259,10 +303,11 @@ command           Execute as a perl statement.
                next; };
            $cmd =~ /^a\s*(\d+)(\s+(.*))?/ && do {
                $i = $1;
-               if ($line[$i] == 0) {
+               if ($dbline[$i] == 0) {
                    print OUT "Line $i may not have an action.\n";
                } else {
-                   $action[$i] = do action($3);
+                   $dbline{$i} =~ s/\0[^\0]*//;
+                   $dbline .= "\0" . do action($3);
                }
                next; };
            $cmd =~ /^n$/ && do {
@@ -276,23 +321,42 @@ command           Execute as a perl statement.
            $cmd =~ /^c\s*(\d*)\s*$/ && do {
                $i = $1;
                if ($i) {
-                   if ($line[$i] == 0) {
+                   if ($dbline[$i] == 0) {
                        print OUT "Line $i not breakable.\n";
                        next;
                    }
-                   $stop[$i] .= ";9";  # add one-time-only b.p.
+                   $dbline{$i} =~ s/(\0|$)/;9$1/;      # add one-time-only b.p.
                }
                for ($i=0; $i <= $#stack; ) {
                    $stack[$i++] &= ~1;
                }
                last; };
-           $cmd =~ /^f$/ && do {
+           $cmd =~ /^r$/ && do {
                $stack[$#stack] |= 2;
                last; };
            $cmd =~ /^T$/ && do {
-               for ($i=0; $i <= $#sub; ) {
-                   print OUT $sub[$i++], "\n";
+               local($p,$f,$l,$s,$h,$a,@a,@sub);
+               for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
+                   @a = @args;
+                   for (@a) {
+                       if (/^StB\000/ && length($_) == length($_main{'_main'})) {
+                           $_ = sprintf("%s",$_);
+                       }
+                       else {
+                           s/'/\\'/g;
+                           s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
+                           s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
+                           s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+                       }
+                   }
+                   $w = $w ? '@ = ' : '$ = ';
+                   $a = $h ? '(' . join(', ', @a) . ')' : '';
+                   push(@sub, "$w&$s$a from file $f line $l\n");
+                   last if $signal;
+               }
+               for ($i=0; $i <= $#sub; $i++) {
                    last if $signal;
+                   print OUT $sub[$i];
                }
                next; };
            $cmd =~ /^\/(.*)$/ && do {
@@ -312,8 +376,8 @@ command             Execute as a perl statement.
                    ++$start;
                    $start = 1 if ($start > $max);
                    last if ($start == $end);
-                   if ($line[$start] =~ m'."\n$pat\n".'i) {
-                       print OUT "$start:\t", $line[$start], "\n";
+                   if ($dbline[$start] =~ m'."\n$pat\n".'i) {
+                       print OUT "$start:\t", $dbline[$start], "\n";
                        last;
                    }
                } ';
@@ -336,8 +400,8 @@ command             Execute as a perl statement.
                    --$start;
                    $start = $max if ($start <= 0);
                    last if ($start == $end);
-                   if ($line[$start] =~ m'."\n$pat\n".'i) {
-                       print OUT "$start:\t", $line[$start], "\n";
+                   if ($dbline[$start] =~ m'."\n$pat\n".'i) {
+                       print OUT "$start:\t", $dbline[$start], "\n";
                        last;
                    }
                } ';
@@ -385,28 +449,40 @@ command           Execute as a perl statement.
                    };
                };
                next; };
-           {
-               package main;
-               eval $DB'cmd;
-           }
-           print OUT $@,"\n";
+           &eval($cmd);
+           print OUT "\n";
        }
        if ($post) {
-           package main;
-           eval $DB'post;  print DB'OUT $@;
+           &eval($post);
        }
     }
+    ($@, $!, $[, $,, $/, $\) = @saved;
+}
+
+sub save {
+    @saved = ($@, $!, $[, $,, $/, $\);
+    $[ = 0; $, = ""; $/ = "\n"; $\ = "";
+}
+
+sub eval {
+    eval "$usercontext $_[0]; &DB'save";
+    print OUT $@;
 }
 
 sub action {
     local($action) = @_;
     while ($action =~ s/\\$//) {
        print OUT "+ ";
-       $action .= <IN>;
+       $action .= &gets;
     }
     $action;
 }
 
+sub gets {
+    local($.);
+    <IN>;
+}
+
 sub catch {
     $signal = 1;
 }
@@ -415,33 +491,19 @@ sub sub {
     push(@stack, $single);
     $single &= 1;
     $single |= 4 if $#stack == $deep;
-    local(@args) = @_;
-    for (@args) {
-       if (/^StB\000/ && length($_) == length($_main{'_main'})) {
-           $_ = sprintf("%s",$_);
-       }
-       else {
-           s/'/\\'/g;
-           s/(.*)/'$1'/ unless /^-?[\d.]+$/;
-       }
-    }
-    push(@sub, $sub . '(' . join(', ', @args) . ') from ' . $line);
     if (wantarray) {
        @i = &$sub;
-       --$#sub;
        $single |= pop(@stack);
        @i;
     }
     else {
        $i = &$sub;
-       --$#sub;
        $single |= pop(@stack);
        $i;
     }
 }
 
 $single = 1;                   # so it stops on first executable statement
-$max = $#line;
 @hist = ('?');
 $SIG{'INT'} = "DB'catch";
 $deep = 100;           # warning if stack gets this deep
@@ -449,13 +511,11 @@ $window = 10;
 $preview = 3;
 
 @stack = (0);
-@args = @ARGV;
+@ARGS = @ARGV;
 for (@args) {
     s/'/\\'/g;
     s/(.*)/'$1'/ unless /^-?[\d.]+$/;
 }
-push(@sub, 'main(' . join(', ', @args) . ")" );
-$sub = 'main';
 
 if (-f '.perldb') {
     do './.perldb';
diff --git a/os2/perlglob.cs b/os2/perlglob.cs
new file mode 100644 (file)
index 0000000..ca3967e
--- /dev/null
@@ -0,0 +1,7 @@
+glob.c
+
+setargv.obj
+perlglob.def
+perlglob.exe
+
+-AS -LB -S0x1000
diff --git a/os2/perlglob.def b/os2/perlglob.def
new file mode 100644 (file)
index 0000000..cfa0739
--- /dev/null
@@ -0,0 +1,3 @@
+NAME PERLGLOB WINDOWCOMPAT NEWFILES
+DESCRIPTION 'Filename globbing for PERL - for MS-DOS and OS/2'
+STUB 'REALGLOB.EXE'
diff --git a/os2/perlsh.cmd b/os2/perlsh.cmd
new file mode 100644 (file)
index 0000000..c583af7
--- /dev/null
@@ -0,0 +1,19 @@
+extproc perl -x
+#!perl
+
+# Poor man's perl shell.
+
+# Simply type two carriage returns every time you want to evaluate.
+# Note that it must be a complete perl statement--don't type double
+#  carriage return in the middle of a loop.
+
+print "Perl shell\n> ";
+
+$/ = '';       # set paragraph mode
+$SHlinesep = "\n";
+
+while ($SHcmd = <>) {
+    $/ = $SHlinesep;
+    eval $SHcmd; print $@ || "\n> ";
+    $SHlinesep = $/; $/ = '';
+}
index 1d54f19..1d5b76f 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 32
+#define PATCHLEVEL 33
index ac2fee7..4f926a4 100644 (file)
@@ -1,7 +1,12 @@
 .rn '' }`
-''' $Header: perl_man.1,v 3.0.1.7 90/08/09 04:24:03 lwall Locked $
+''' $Header: perl_man.1,v 3.0.1.8 90/10/15 18:16:19 lwall Locked $
 ''' 
 ''' $Log:      perl.man.1,v $
+''' Revision 3.0.1.8  90/10/15  18:16:19  lwall
+''' patch29: added DATA filehandle to read stuff after __END__
+''' patch29: added cmp and <=>
+''' patch29: added -M, -A and -C
+''' 
 ''' Revision 3.0.1.7  90/08/09  04:24:03  lwall
 ''' patch19: added -x switch to extract script from input trash
 ''' patch19: Added -c switch to do compilation only
@@ -451,7 +456,7 @@ The
 switch only controls the the disposal of leading garbage.
 The script must be terminated with __END__ if there is trailing garbage
 to be ignored (the script can process any or all of the trailing garbage
-via standard input if desired).
+via the DATA filehandle if desired).
 .Sh "Data Types and Objects"
 .PP
 .I Perl
@@ -622,10 +627,8 @@ They may only be used as separate tokens; they will not be interpolated
 into strings.
 In addition, the token __END__ may be used to indicate the logical end of the
 script before the actual end of file.
-Any following text is ignored (but if the script is being read from
-the standard input, then the rest of the input is available by reading
-from filehandle STDIN).
-The two control characters ^D and ^Z are synonyms for __END__.
+Any following text is ignored (but may be read via the DATA filehandle).
+The two control characters ^D and ^Z are synomyms for __END__.
 .PP
 A word that doesn't have any other interpretation in the grammar will be
 treated as if it had single quotes around it.
@@ -1305,6 +1308,10 @@ String greater than.
 String less than or equal.
 .Ip ge 8
 String greater than or equal.
+.Ip cmp 8
+String comparison, returning -1, 0, or 1.
+.Ip <=> 8
+Numeric comparison, returning -1, 0, or 1.
 .Ip =~ 8 2
 Certain operations search or modify the string \*(L"$_\*(R" by default.
 This operator makes that kind of operation work on some other string.
@@ -1423,6 +1430,9 @@ The operator may be any of:
        \-t     Filehandle is opened to a tty.
        \-T     File is a text file.
        \-B     File is a binary file (opposite of \-T).
+       \-M     Age of file in days when script started.
+       \-A     Same for access time.
+       \-C     Same for inode change time.
 
 .fi
 The interpretation of the file permission operators \-r, \-R, \-w, \-W, \-x and \-X
index 2f7b514..1166c93 100644 (file)
@@ -1,7 +1,12 @@
 ''' Beginning of part 2
-''' $Header: perl_man.2,v 3.0.1.8 90/08/13 22:21:00 lwall Locked $
+''' $Header: perl_man.2,v 3.0.1.9 90/10/15 18:17:37 lwall Locked $
 '''
 ''' $Log:      perl.man.2,v $
+''' Revision 3.0.1.9  90/10/15  18:17:37  lwall
+''' patch29: added caller
+''' patch29: index and substr now have optional 3rd args
+''' patch29: added SysV IPC
+''' 
 ''' Revision 3.0.1.8  90/08/13  22:21:00  lwall
 ''' patch28: documented that you can't interpolate $) or $| in pattern
 ''' 
@@ -88,6 +93,17 @@ to LF on input and LF translated to CR LF on output.
 Binmode has no effect under Unix.
 If FILEHANDLE is an expression, the value is taken as the name of
 the filehandle.
+.Ip "caller(EXPR)"
+.Ip "caller"
+Returns the context of the current subroutine call:
+.nf
+
+       ($package,$filename,$line) = caller;
+
+.fi
+With EXPR, returns some extra information that the debugger uses to print
+a stack trace.  The value of EXPR indicates how many call frames to go
+back before the current one.
 .Ip "chdir(EXPR)" 8 2
 .Ip "chdir EXPR" 8 2
 Changes the working directory to EXPR, if possible.
@@ -824,8 +840,12 @@ the LIST is not a named array.
 Returns the decimal value of EXPR interpreted as an hex string.
 (To interpret strings that might start with 0 or 0x see oct().)
 If EXPR is omitted, uses $_.
+.Ip "index(STR,SUBSTR,POSITION)" 8 4
 .Ip "index(STR,SUBSTR)" 8 4
-Returns the position of the first occurrence of SUBSTR in STR, based at 0, or whatever you've
+Returns the position of the first occurrence of SUBSTR in STR at or after
+POSITION.
+If POSITION is omitted, starts searching from the beginning of the string.
+The return value is based at 0, or whatever you've
 set the $[ variable to.
 If the substring is not found, returns one less than the base, ordinarily \-1.
 .Ip "int(EXPR)" 8 4
@@ -985,8 +1005,8 @@ This means that called subroutines can also reference the local variable,
 but not the global one.
 The LIST may be assigned to if desired, which allows you to initialize
 your local variables.
-(If no initializer is given, all scalars are initialized to the null string
-and all arrays and associative arrays to the null array.)
+(If no initializer is given for a particular variable, it is created with
+an undefined value.)
 Commonly this is used to name the parameters to a subroutine.
 Examples:
 .nf
@@ -1123,3 +1143,23 @@ matched.
 Creates the directory specified by FILENAME, with permissions specified by
 MODE (as modified by umask).
 If it succeeds it returns 1, otherwise it returns 0 and sets $! (errno).
+.Ip "msgctl(ID,CMD,ARG)" 8 4
+Calls the System V IPC function msgctl.  If CMD is &IPC_STAT, then ARG
+must be a variable which will hold the returned msqid_ds structure.
+Returns like ioctl: the undefined value for error, "0 but true" for
+zero, or the actual return value otherwise.
+.Ip "msgget(KEY,FLAGS)" 8 4
+Calls the System V IPC function msgget.  Returns the message queue id,
+or the undefined value if there is an error.
+.Ip "msgsnd(ID,MSG,FLAGS)" 8 4
+Calls the System V IPC function msgsnd to send the message MSG to the
+message queue ID.  MSG must begin with the long integer message type,
+which may be created with pack("L", $type).  Returns true if
+successful, or false if there is an error.
+.Ip "msgrcv(ID,VAR,SIZE,TYPE,FLAGS)" 8 4
+Calls the System V IPC function msgrcv to receive a message from
+message queue ID into variable VAR with a maximum message size of
+SIZE.  Note that if a message is received, the message type will be
+the first thing in VAR, and the maximum length of VAR is SIZE plus the
+size of the message type.  Returns true if successful, or false if
+there is an error.
index bfd2b30..92b2676 100644 (file)
@@ -1,7 +1,16 @@
 ''' Beginning of part 3
-''' $Header: perl_man.3,v 3.0.1.8 90/08/09 04:39:04 lwall Locked $
+''' $Header: perl_man.3,v 3.0.1.9 90/10/16 10:02:43 lwall Locked $
 '''
 ''' $Log:      perl.man.3,v $
+''' Revision 3.0.1.9  90/10/16  10:02:43  lwall
+''' patch29: you can now read into the middle string
+''' patch29: index and substr now have optional 3rd args
+''' patch29: added scalar reverse
+''' patch29: added scalar
+''' patch29: added SysV IPC
+''' patch29: added waitpid
+''' patch29: added sysread and syswrite
+''' 
 ''' Revision 3.0.1.8  90/08/09  04:39:04  lwall
 ''' patch19: added require operator
 ''' patch19: added truncate operator
@@ -417,11 +426,16 @@ Returns a random fractional number between 0 and the value of EXPR.
 (EXPR should be positive.)
 If EXPR is omitted, returns a value between 0 and 1.
 See also srand().
+.Ip "read(FILEHANDLE,SCALAR,LENGTH,OFFSET)" 8 5
 .Ip "read(FILEHANDLE,SCALAR,LENGTH)" 8 5
 Attempts to read LENGTH bytes of data into variable SCALAR from the specified
 FILEHANDLE.
-Returns the number of bytes actually read.
+Returns the number of bytes actually read, or undef if there was an error.
 SCALAR will be grown or shrunk to the length actually read.
+An OFFSET may be specified to place the read data at some other place
+than the beginning of the string.
+This call is actually implemented in terms of stdio's fread call.  To get
+a true read system call, see sysread.
 .Ip "readdir(DIRHANDLE)" 8 3
 .Ip "readdir DIRHANDLE" 8
 Returns the next directory entry for a directory opened by opendir().
@@ -547,13 +561,19 @@ That's the preferred method\*(--use of an explicit
 is a bit slower.)
 .Ip "reverse(LIST)" 8 4
 .Ip "reverse LIST" 8
-Returns an array value consisting of the elements of LIST in the opposite order.
+In an array context, returns an array value consisting of the elements
+of LIST in the opposite order.
+In a scalar context, returns a string value consisting of the bytes of
+the first element of LIST in the opposite order.
 .Ip "rewinddir(DIRHANDLE)" 8 5
 .Ip "rewinddir DIRHANDLE" 8
 Sets the current position to the beginning of the directory for the readdir() routine on DIRHANDLE.
+.Ip "rindex(STR,SUBSTR,POSITION)" 8 6
 .Ip "rindex(STR,SUBSTR)" 8 4
 Works just like index except that it
 returns the position of the LAST occurrence of SUBSTR in STR.
+If POSITION is specified, returns the last occurrence at or before that
+position.
 .Ip "rmdir(FILENAME)" 8 4
 .Ip "rmdir FILENAME" 8
 Deletes the directory specified by FILENAME if it is empty.
@@ -606,6 +626,9 @@ Examples:
 .fi
 (Note the use of $ instead of \|\e\| in the last example.  See section
 on regular expressions.)
+.Ip "scalar(EXPR)" 8 3
+Forces EXPR to be interpreted in a scalar context and returns the value
+of EXPR.
 .Ip "seek(FILEHANDLE,POSITION,WHENCE)" 8 3
 Randomly positions the file pointer for FILEHANDLE, just like the fseek()
 call of stdio.
@@ -691,6 +714,30 @@ Any of the bitmasks can also be undef.
 The timeout, if specified, is in seconds, which may be fractional.
 NOTE: not all implementations are capable of returning the $timeleft.
 If not, they always return $timeleft equal to the supplied $timeout.
+.Ip "semctl(ID,SEMNUM,CMD,ARG)" 8 4
+Calls the System V IPC function semctl.  If CMD is &IPC_STAT or
+&GETALL, then ARG must be a variable which will hold the returned
+semid_ds structure or semaphore value array.  Returns like ioctl: the
+undefined value for error, "0 but true" for zero, or the actual return
+value otherwise.
+.Ip "semget(KEY,NSEMS,SIZE,FLAGS)" 8 4
+Calls the System V IPC function semget.  Returns the semaphore id, or
+the undefined value if there is an error.
+.Ip "semop(KEY,OPSTRING)" 8 4
+Calls the System V IPC function semop to perform semaphore operations
+such as signaling and waiting.  OPSTRING must be a packed array of
+semop structures.  Each semop structure can be generated with
+'pack("sss", $semnum, $semop, $semflag)'.  The number of semaphore
+operations is implied by the length of OPSTRING.  Returns true if
+successful, or false if there is an error.  As an example, the
+following code waits on semaphore $semnum of semaphore id $semid:
+.nf
+
+       $semop = pack("sss", $semnum, -1, 0);
+       die "Semaphore trouble: $!\n" unless semop($semid, $semop);
+
+.fi
+To signal the semaphore, replace "-1" with "1".
 .Ip "send(SOCKET,MSG,FLAGS,TO)" 8 4
 .Ip "send(SOCKET,MSG,FLAGS)" 8
 Sends a message on a socket.
@@ -720,9 +767,27 @@ shortening the array by 1 and moving everything down.
 If there are no elements in the array, returns the undefined value.
 If ARRAY is omitted, shifts the @ARGV array in the main program, and the @_
 array in subroutines.
+(This is determined lexically.)
 See also unshift(), push() and pop().
 Shift() and unshift() do the same thing to the left end of an array that push()
 and pop() do to the right end.
+.Ip "shmctl(ID,CMD,ARG)" 8 4
+Calls the System V IPC function shmctl.  If CMD is &IPC_STAT, then ARG
+must be a variable which will hold the returned shmid_ds structure.
+Returns like ioctl: the undefined value for error, "0 but true" for
+zero, or the actual return value otherwise.
+.Ip "shmget(KEY,SIZE,FLAGS)" 8 4
+Calls the System V IPC function shmget.  Returns the shared memory
+segment id, or the undefined value if there is an error.
+.Ip "shmread(ID,VAR,POS,SIZE)" 8 4
+.Ip "shmwrite(ID,STRING,POS,SIZE)" 8
+Reads or writes the System V shared memory segment ID starting at
+position POS for size SIZE by attaching to it, copying in/out, and
+detaching from it.  When reading, VAR must be a variable which
+will hold the data read.  When writing, if STRING is too long,
+only SIZE bytes are used; if STRING is too short, nulls are
+written to fill out SIZE bytes.  Return true if successful, or
+false if there is an error.
 .Ip "shutdown(SOCKET,HOW)" 8 3
 Shuts down a socket connection in the manner indicated by HOW, which has
 the same interpretation as in the system call of the same name.
@@ -800,7 +865,7 @@ If LENGTH is omitted, removes everything from OFFSET onward.
 The following equivalencies hold (assuming $[ == 0):
 .nf
 
-       push(@a,$x,$y)\h'|3.5i'splice(@a,$#x+1,0,$x,$y)
+       push(@a,$x,$y)\h'|3.5i'splice(@a,$#a+1,0,$x,$y)
        pop(@a)\h'|3.5i'splice(@a,-1)
        shift(@a)\h'|3.5i'splice(@a,0,1)
        unshift(@a,$x,$y)\h'|3.5i'splice(@a,0,0,$x,$y)
@@ -1009,9 +1074,11 @@ contain a match:
 
 .fi
 .Ip "substr(EXPR,OFFSET,LEN)" 8 2
+.Ip "substr(EXPR,OFFSET)" 8 2
 Extracts a substring out of EXPR and returns it.
 First character is at offset 0, or whatever you've set $[ to.
 If OFFSET is negative, starts that far from the end of the string.
+If LEN is omitted, returns everything to the end of the string.
 You can use the substr() function as an lvalue, in which case EXPR must
 be an lvalue.
 If you assign something shorter than LEN, the string will shrink, and
@@ -1048,6 +1115,16 @@ like numbers.
        syscall(&SYS_write, fileno(STDOUT), "hi there\en", 9);
 
 .fi
+.Ip "sysread(FILEHANDLE,SCALAR,LENGTH,OFFSET)" 8 5
+.Ip "sysread(FILEHANDLE,SCALAR,LENGTH)" 8 5
+Attempts to read LENGTH bytes of data into variable SCALAR from the specified
+FILEHANDLE, using the system call read(2).
+It bypasses stdio, so mixing this with other kinds of reads may cause
+confusion.
+Returns the number of bytes actually read, or undef if there was an error.
+SCALAR will be grown or shrunk to the length actually read.
+An OFFSET may be specified to place the read data at some other place
+than the beginning of the string.
 .Ip "system(LIST)" 8 6
 .Ip "system LIST" 8
 Does exactly the same thing as \*(L"exec LIST\*(R" except that a fork
@@ -1058,6 +1135,15 @@ call.
 To get the actual exit value divide by 256.
 See also
 .IR exec .
+.Ip "syswrite(FILEHANDLE,SCALAR,LENGTH,OFFSET)" 8 5
+.Ip "syswrite(FILEHANDLE,SCALAR,LENGTH)" 8 5
+Attempts to write LENGTH bytes of data from variable SCALAR to the specified
+FILEHANDLE, using the system call write(2).
+It bypasses stdio, so mixing this with prints may cause
+confusion.
+Returns the number of bytes actually written, or undef if there was an error.
+An OFFSET may be specified to place the read data at some other place
+than the beginning of the string.
 .Ip "tell(FILEHANDLE)" 8 6
 .Ip "tell FILEHANDLE" 8 6
 .Ip "tell" 8
@@ -1245,9 +1331,28 @@ your program, to protect older programs.
 Waits for a child process to terminate and returns the pid of the deceased
 process, or -1 if there are no child processes.
 The status is returned in $?.
-If you expected a child and didn't find it, you probably had a call to
-system, a close on a pipe, or backticks between the fork and the wait.
-These constructs also do a wait and may have harvested your child process.
+.Ip "waitpid(PID,FLAGS)" 8 6
+Waits for a particular child process to terminate and returns the pid of the deceased
+process, or -1 if there is no such child process.
+The status is returned in $?.
+If you say
+.nf
+
+       require "sys/wait.h";
+       .\|.\|.
+       waitpid(-1,&WNOHANG);
+
+.fi
+then you can do a non-blocking wait for any process.  Non-blocking wait
+is only available on machines supporting either the
+.I waitpid (2)
+or
+.I wait4 (2)
+system calls.
+However, waiting for a particular pid with FLAGS of 0 is implemented
+everywhere.  (Perl emulates the system call by remembering the status
+values of processes that have exited but have not been harvested by the
+Perl script yet.)
 .Ip "wantarray" 8 4
 Returns true if the context of the currently executing subroutine
 is looking for an array value.
index a1febef..145284e 100644 (file)
@@ -1,7 +1,10 @@
 ''' Beginning of part 4
-''' $Header: perl_man.4,v 3.0.1.10 90/08/09 04:47:35 lwall Locked $
+''' $Header: perl_man.4,v 3.0.1.11 90/10/16 10:04:28 lwall Locked $
 '''
 ''' $Log:      perl.man.4,v $
+''' Revision 3.0.1.11  90/10/16  10:04:28  lwall
+''' patch29: added @###.## fields to format
+''' 
 ''' Revision 3.0.1.10  90/08/09  04:47:35  lwall
 ''' patch19: added require operator
 ''' patch19: added numeric interpretation of $]
@@ -396,6 +399,8 @@ to do rudimentary multi-line text block filling.
 The length of the field is supplied by padding out the field
 with multiple <, >, or | characters to specify, respectively, left justification,
 right justification, or centering.
+As an alternate form of right justification,
+you may also use # characters (with an optional .) to specify a numeric field.
 If any of the values supplied for these fields contains a newline, only
 the text up to the newline is printed.
 The special field @* can be used for printing multi-line values.
@@ -1220,6 +1225,7 @@ may be redirected to.
 .PP
 If you want to modify the debugger, copy perldb.pl from the perl library
 to your current directory and modify it as necessary.
+(You'll also have to put -I. on your command line.)
 You can do some customization by setting up a .perldb file which contains
 initialization code.
 For instance, you could make aliases like these:
diff --git a/stab.h b/stab.h
index aeb7133..eb4b56f 100644 (file)
--- a/stab.h
+++ b/stab.h
@@ -1,4 +1,4 @@
-/* $Header: stab.h,v 3.0.1.3 90/08/09 05:18:42 lwall Locked $
+/* $Header: stab.h,v 3.0.1.4 90/10/16 10:33:08 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       stab.h,v $
+ * Revision 3.0.1.4  90/10/16  10:33:08  lwall
+ * patch29: *foo now prints as *package'foo
+ * patch29: package behavior is now more consistent
+ * 
  * Revision 3.0.1.3  90/08/09  05:18:42  lwall
  * patch19: Added support for linked-in C subroutines
  * 
@@ -27,6 +31,7 @@ struct stabptrs {
     FCMD       *stbp_form;     /* format value */
     ARRAY      *stbp_array;    /* array value */
     HASH       *stbp_hash;     /* associative array value */
+    HASH       *stbp_stash;    /* symbol table for this stab */
     SUBR       *stbp_sub;      /* subroutine value */
     int                stbp_lastexpr;  /* used by nothing_in_common() */
     line_t     stbp_line;      /* line first declared at (for -w) */
@@ -57,6 +62,7 @@ HASH *stab_hash();
                                 ((STBP*)(stab->str_ptr))->stbp_hash : \
                                 ((STBP*)(hadd(stab)->str_ptr))->stbp_hash)
 #endif                 /* Microport 2.4 hack */
+#define stab_stash(stab)       (((STBP*)(stab->str_ptr))->stbp_stash)
 #define stab_sub(stab)         (((STBP*)(stab->str_ptr))->stbp_sub)
 #define stab_lastexpr(stab)    (((STBP*)(stab->str_ptr))->stbp_lastexpr)
 #define stab_line(stab)                (((STBP*)(stab->str_ptr))->stbp_line)
@@ -93,7 +99,7 @@ struct sub {
     CMD                *cmd;
     int                (*usersub)();
     int                userindex;
-    char       *filename;
+    STAB       *filestab;
     long       depth;  /* >= 2 indicates recursive call */
     ARRAY      *tosave;
 };
@@ -117,3 +123,4 @@ EXT int delaymagic INIT(0);
 
 STAB *aadd();
 STAB *hadd();
+STAB *fstab();