lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (10/17/90)
System: perl version 3.0 Patch #: 33 Priority: HIGH Subject: patch #29, continued Description: See patch #29. Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle". If you don't have the patch program, apply the following by hand, or get patch (version 2.0, latest patchlevel). After patching: *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #36 FIRST *** If patch indicates that patchlevel is the wrong version, you may need to apply one or more previous patches, or the patch may already have been applied. See the patchlevel.h file to find out what has or has not been applied. In any event, don't continue with the patch. If you are missing previous patches they can be obtained from me: Larry Wall lwall@jpl-devvax.jpl.nasa.gov If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 3.0 LIST ^ note the c where PATH is a return path FROM ME TO YOU either in Internet notation, or in bang notation from some well-known host, and LIST is the number of one or more patches you need, separated by spaces, commas, and/or hyphens. Saying 35- says everything from 35 to the end. You can also get the patches via anonymous FTP from jpl-devvax.jpl.nasa.gov (128.149.1.143). Index: patchlevel.h Prereq: 32 1c1 < #define PATCHLEVEL 32 --- > #define PATCHLEVEL 33 Index: perl_man.1 Prereq: 3.0.1.7 *** perl_man.1.old Tue Oct 16 11:58:04 1990 --- perl_man.1 Tue Oct 16 11:58:15 1990 *************** *** 1,7 **** .rn '' }` ! ''' $Header: perl_man.1,v 3.0.1.7 90/08/09 04:24:03 lwall Locked $ ''' ''' $Log: perl_man.1,v $ ''' 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 --- 1,12 ---- .rn '' }` ! ''' $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,457 **** 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). .Sh "Data Types and Objects" .PP .I Perl --- 456,462 ---- 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 the DATA filehandle if desired). .Sh "Data Types and Objects" .PP .I Perl *************** *** 622,631 **** 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__. .PP A word that doesn't have any other interpretation in the grammar will be treated as if it had single quotes around it. --- 627,634 ---- 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 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,1310 **** --- 1308,1317 ---- 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,1428 **** --- 1430,1438 ---- \-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: perl_man.2 Prereq: 3.0.1.8 *** perl_man.2.old Tue Oct 16 11:58:45 1990 --- perl_man.2 Tue Oct 16 11:58:57 1990 *************** *** 1,7 **** ''' Beginning of part 2 ! ''' $Header: perl_man.2,v 3.0.1.8 90/08/13 22:21:00 lwall Locked $ ''' ''' $Log: perl_man.2,v $ ''' Revision 3.0.1.8 90/08/13 22:21:00 lwall ''' patch28: documented that you can't interpolate $) or $| in pattern ''' --- 1,12 ---- ''' Beginning of part 2 ! ''' $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,93 **** --- 93,109 ---- 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,831 **** 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)" 8 4 ! Returns the position of the first occurrence of SUBSTR in STR, 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 --- 840,851 ---- 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 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,992 **** 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.) Commonly this is used to name the parameters to a subroutine. Examples: .nf --- 1005,1012 ---- 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 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,1125 **** --- 1143,1165 ---- 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: perl_man.3 Prereq: 3.0.1.8 *** perl_man.3.old Tue Oct 16 11:59:25 1990 --- perl_man.3 Tue Oct 16 11:59:39 1990 *************** *** 1,7 **** ''' Beginning of part 3 ! ''' $Header: perl_man.3,v 3.0.1.8 90/08/09 04:39:04 lwall Locked $ ''' ''' $Log: perl_man.3,v $ ''' Revision 3.0.1.8 90/08/09 04:39:04 lwall ''' patch19: added require operator ''' patch19: added truncate operator --- 1,16 ---- ''' Beginning of part 3 ! ''' $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,427 **** (EXPR should be positive.) If EXPR is omitted, returns a value between 0 and 1. See also srand(). .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. SCALAR will be grown or shrunk to the length actually read. .Ip "readdir(DIRHANDLE)" 8 3 .Ip "readdir DIRHANDLE" 8 Returns the next directory entry for a directory opened by opendir(). --- 426,441 ---- (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, 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,559 **** 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. .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)" 8 4 Works just like index except that it returns the position of the LAST occurrence of SUBSTR in STR. .Ip "rmdir(FILENAME)" 8 4 .Ip "rmdir FILENAME" 8 Deletes the directory specified by FILENAME if it is empty. --- 561,579 ---- is a bit slower.) .Ip "reverse(LIST)" 8 4 .Ip "reverse LIST" 8 ! 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,611 **** --- 626,634 ---- .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,696 **** --- 714,743 ---- 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,728 **** --- 767,793 ---- 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,806 **** The following equivalencies hold (assuming $[ == 0): .nf ! push(@a,$x,$y)\h'|3.5i'splice(@a,$#x+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) --- 865,871 ---- The following equivalencies hold (assuming $[ == 0): .nf ! 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,1017 **** --- 1074,1084 ---- .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,1053 **** --- 1115,1130 ---- 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,1063 **** --- 1135,1149 ---- 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,1253 **** 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 "wantarray" 8 4 Returns true if the context of the currently executing subroutine is looking for an array value. --- 1331,1358 ---- 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 $?. ! .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: perl_man.4 Prereq: 3.0.1.10 *** perl_man.4.old Tue Oct 16 12:00:20 1990 --- perl_man.4 Tue Oct 16 12:00:40 1990 *************** *** 1,7 **** ''' Beginning of part 4 ! ''' $Header: perl_man.4,v 3.0.1.10 90/08/09 04:47:35 lwall Locked $ ''' ''' $Log: perl_man.4,v $ ''' Revision 3.0.1.10 90/08/09 04:47:35 lwall ''' patch19: added require operator ''' patch19: added numeric interpretation of $] --- 1,10 ---- ''' Beginning of part 4 ! ''' $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,401 **** --- 399,406 ---- 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,1225 **** --- 1225,1231 ---- .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: Index: lib/perldb.pl Prereq: 3.0.1.3 *** lib/perldb.pl.old Tue Oct 16 11:53:32 1990 --- lib/perldb.pl Tue Oct 16 11:53:34 1990 *************** *** 1,6 **** package DB; ! $header = '$Header: perldb.pl,v 3.0.1.3 90/08/09 04:00:58 lwall Locked $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. --- 1,6 ---- package DB; ! $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,15 **** --- 10,21 ---- # 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,79 **** # # ! open(IN,"/dev/tty"); # so we don't dingle stdin ! open(OUT,">/dev/tty"); # so we don't dongle stdout select(OUT); $| = 1; # for DB'OUT select(STDOUT); $| = 1; # for real STDOUT $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; ! print OUT "\nLoading custom DB from $header\n\nEnter h for help.\n\n"; sub DB { ! local($. ,$@, $!, $[, $,, $/, $\); ! $[ = 0; $, = ""; $/ = "\n"; $\ = ""; ! ($line) = @_; ! if ($stop[$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$//; } } 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]; } } ! if ($action[$line]) { ! package main; ! eval $DB'action[$DB'line]; print DB'OUT $@; ! } if ($single || $signal) { ! if ($pre) { ! package main; ! eval $DB'pre; print DB'OUT $@; ! } print OUT $#stack . " levels deep in subroutine calls!\n" if $single & 4; $start = $line; ! while ((print OUT " DB<", $#hist+1, "> "), $cmd=<IN>) { $single = 0; $signal = 0; $cmd eq '' && exit 0; --- 36,83 ---- # # ! 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 DB routines from $header\n\nEnter h for help.\n\n"; sub DB { ! &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 { ! $signal |= &eval($stop); ! $dbline{$line} =~ s/;9($|\0)/$1/; } } if ($single || $trace || $signal) { ! 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]; } } ! &eval($action) if $action; if ($single || $signal) { ! &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=&gets) { $single = 0; $signal = 0; $cmd eq '' && exit 0; *************** *** 80,86 **** chop($cmd); $cmd =~ s/\\$// && do { print OUT " cont: "; ! $cmd .= <IN>; redo; }; $cmd =~ /^q$/ && exit 0; --- 84,90 ---- chop($cmd); $cmd =~ s/\\$// && do { print OUT " cont: "; ! $cmd .= &gets; redo; }; $cmd =~ /^q$/ && exit 0; *************** *** 93,99 **** T Stack trace. s Single step. n Next, steps over subroutine calls. ! f Finish current subroutine. c [line] Continue; optionally inserts a one-time-only breakpoint at the specified line. <CR> Repeat last n or s. --- 97,103 ---- T Stack trace. s Single step. n Next, steps over subroutine calls. ! 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,109 **** --- 108,114 ---- - 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,128 **** 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]\". < command Define command before prompt. > command Define command after prompt. ! number Redo command (default previous command). --- 126,133 ---- 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 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). *************** *** 129,137 **** ! -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\". = [alias value] Define a command alias, or list current aliases. ! command Execute as a perl statement. "; next; }; --- 134,142 ---- ! -number Redo number\'th to last command. H -number Display last number commands (default all). q or ^D Quit. ! 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 in current package. "; next; }; *************** *** 141,158 **** next; }; $cmd =~ /^S$/ && do { foreach $subname (sort(keys %sub)) { ! if ($subname =~ /^main'(.*)/) { ! print OUT $1,"\n"; ! } ! else { ! print OUT $subname,"\n"; ! } } next; }; ! $cmd =~ s/^X\b/V main/; $cmd =~ /^V$/ && do { ! $cmd = 'V main'; }; ! $cmd =~ /^V\s*(\S+)\s*(.*)/ && do { $packname = $1; @vars = split(' ',$2); do 'dumpvar.pl' unless defined &main'dumpvar; --- 146,158 ---- next; }; $cmd =~ /^S$/ && do { foreach $subname (sort(keys %sub)) { ! print OUT $subname,"\n"; } next; }; ! $cmd =~ s/^X\b/V $package/; $cmd =~ /^V$/ && do { ! $cmd = 'V $package'; }; ! $cmd =~ /^V\s*(\S+)\s*(.*)/ && do { $packname = $1; @vars = split(' ',$2); do 'dumpvar.pl' unless defined &main'dumpvar; *************** *** 163,172 **** print DB'OUT "dumpvar.pl not available.\n"; } next; }; $cmd =~ /^l\s*(['A-Za-z_]['\w]*)/ && do { $subname = $1; $subname = "main'" . $subname unless $subname =~ /'/; ! $subrange = $sub{$subname}; if ($subrange) { if (eval($subrange) < -$window) { $subrange =~ s/-.*/+/; --- 163,202 ---- 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 =~ /'/; ! $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,205 **** $i = $line if $i eq '.'; $i = 1 if $i < 1; for (; $i <= $end; $i++) { ! print OUT "$i:\t", $line[$i]; last if $signal; } $start = $i; # remember in case they want more --- 229,235 ---- $i = $line if $i eq '.'; $i = 1 if $i < 1; for (; $i <= $end; $i++) { ! print OUT "$i:\t", $dbline[$i]; last if $signal; } $start = $i; # remember in case they want more *************** *** 208,224 **** $cmd =~ /^D$/ && do { print OUT "Deleting all breakpoints...\n"; for ($i = 1; $i <= $max ; $i++) { ! $stop[$i] = 0; } 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]; last if $signal; } } --- 238,260 ---- $cmd =~ /^D$/ && do { print OUT "Deleting all breakpoints...\n"; for ($i = 1; $i <= $max ; $i++) { ! 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 (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; } } *************** *** 225,254 **** next; }; $cmd =~ /^b\s*(['A-Za-z_]['\w]*)\s*(.*)/ && do { $subname = $1; ! $subname = "main'" . $subname unless $subname =~ /'/; ! ($i) = split(/-/, $sub{$subname}); if ($i) { ! ++$i while $line[$i] == 0 && $i < $#line; ! $stop[$i] = $2 ? $2 : 1; } else { ! print OUT "Subroutine $1 not found.\n"; } next; }; $cmd =~ /^b\s*(\d*)\s*(.*)/ && do { $i = ($1?$1:$line); ! if ($line[$i] == 0) { print OUT "Line $i not breakable.\n"; } else { ! $stop[$i] = $2 ? $2 : 1; } next; }; $cmd =~ /^d\s*(\d+)?/ && do { $i = ($1?$1:$line); ! $stop[$i] = ''; next; }; $cmd =~ /^A$/ && do { for ($i = 1; $i <= $max ; $i++) { ! $action[$i] = ''; } next; }; $cmd =~ /^<\s*(.*)/ && do { --- 261,298 ---- next; }; $cmd =~ /^b\s*(['A-Za-z_]['\w]*)\s*(.*)/ && do { $subname = $1; ! $cond = $2 || '1'; ! $subname = "$package'" . $subname unless $subname =~ /'/; ! $subname = "main" . $subname if substr($subname,0,1) eq "'"; ! ($filename,$i) = split(/[:-]/, $sub{$subname}); if ($i) { ! *dbline = "_<$filename"; ! ++$i while $dbline[$i] == 0 && $i < $#dbline; ! $dbline{$i} =~ s/^[^\0]*/$cond/; } else { ! print OUT "Subroutine $subname not found.\n"; } next; }; $cmd =~ /^b\s*(\d*)\s*(.*)/ && do { $i = ($1?$1:$line); ! $cond = $2 || '1'; ! if ($dbline[$i] == 0) { print OUT "Line $i not breakable.\n"; } else { ! $dbline{$i} =~ s/^[^\0]*/$cond/; } next; }; $cmd =~ /^d\s*(\d+)?/ && do { $i = ($1?$1:$line); ! $dbline{$i} =~ s/^[^\0]*//; ! delete $dbline{$i} if $dbline{$i} eq ''; next; }; $cmd =~ /^A$/ && do { for ($i = 1; $i <= $max ; $i++) { ! if (defined $dbline{$i}) { ! $dbline{$i} =~ s/\0[^\0]*//; ! delete $dbline{$i} if $dbline{$i} eq ''; ! } } next; }; $cmd =~ /^<\s*(.*)/ && do { *************** *** 259,268 **** next; }; $cmd =~ /^a\s*(\d+)(\s+(.*))?/ && do { $i = $1; ! if ($line[$i] == 0) { print OUT "Line $i may not have an action.\n"; } else { ! $action[$i] = do action($3); } next; }; $cmd =~ /^n$/ && do { --- 303,313 ---- next; }; $cmd =~ /^a\s*(\d+)(\s+(.*))?/ && do { $i = $1; ! if ($dbline[$i] == 0) { print OUT "Line $i may not have an action.\n"; } else { ! $dbline{$i} =~ s/\0[^\0]*//; ! $dbline .= "\0" . do action($3); } next; }; $cmd =~ /^n$/ && do { *************** *** 276,299 **** $cmd =~ /^c\s*(\d*)\s*$/ && do { $i = $1; if ($i) { ! if ($line[$i] == 0) { print OUT "Line $i not breakable.\n"; next; } ! $stop[$i] .= ";9"; # add one-time-only b.p. } for ($i=0; $i <= $#stack; ) { $stack[$i++] &= ~1; } last; }; ! $cmd =~ /^f$/ && do { $stack[$#stack] |= 2; last; }; $cmd =~ /^T$/ && do { ! for ($i=0; $i <= $#sub; ) { ! print OUT $sub[$i++], "\n"; last if $signal; } next; }; $cmd =~ /^\/(.*)$/ && do { $inpat = $1; --- 321,363 ---- $cmd =~ /^c\s*(\d*)\s*$/ && do { $i = $1; if ($i) { ! if ($dbline[$i] == 0) { print OUT "Line $i not breakable.\n"; next; } ! $dbline{$i} =~ s/(\0|$)/;9$1/; # add one-time-only b.p. } for ($i=0; $i <= $#stack; ) { $stack[$i++] &= ~1; } last; }; ! $cmd =~ /^r$/ && do { $stack[$#stack] |= 2; last; }; $cmd =~ /^T$/ && do { ! 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 { $inpat = $1; *************** *** 312,319 **** ++$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"; last; } } '; --- 376,383 ---- ++$start; $start = 1 if ($start > $max); last if ($start == $end); ! if ($dbline[$start] =~ m'."\n$pat\n".'i) { ! print OUT "$start:\t", $dbline[$start], "\n"; last; } } '; *************** *** 336,343 **** --$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"; last; } } '; --- 400,407 ---- --$start; $start = $max if ($start <= 0); last if ($start == $end); ! if ($dbline[$start] =~ m'."\n$pat\n".'i) { ! print OUT "$start:\t", $dbline[$start], "\n"; last; } } '; *************** *** 385,412 **** }; }; next; }; ! { ! package main; ! eval $DB'cmd; ! } ! print OUT $@,"\n"; } if ($post) { ! package main; ! eval $DB'post; print DB'OUT $@; } } } sub action { local($action) = @_; while ($action =~ s/\\$//) { print OUT "+ "; ! $action .= <IN>; } $action; } sub catch { $signal = 1; } --- 449,488 ---- }; }; next; }; ! &eval($cmd); ! print OUT "\n"; } if ($post) { ! &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 .= &gets; } $action; } + sub gets { + local($.); + <IN>; + } + sub catch { $signal = 1; } *************** *** 415,440 **** 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; } --- 491,503 ---- *************** *** 441,447 **** } $single = 1; # so it stops on first executable statement - $max = $#line; @hist = ('?'); $SIG{'INT'} = "DB'catch"; $deep = 100; # warning if stack gets this deep --- 504,509 ---- *************** *** 449,461 **** $preview = 3; @stack = (0); ! @args = @ARGV; for (@args) { s/'/\\'/g; s/(.*)/'$1'/ unless /^-?[\d.]+$/; } - push(@sub, 'main(' . join(', ', @args) . ")" ); - $sub = 'main'; if (-f '.perldb') { do './.perldb'; --- 511,521 ---- $preview = 3; @stack = (0); ! @ARGS = @ARGV; for (@args) { s/'/\\'/g; s/(.*)/'$1'/ unless /^-?[\d.]+$/; } if (-f '.perldb') { do './.perldb'; Index: os2/perlglob.cs *** os2/perlglob.cs.old Tue Oct 16 11:56:11 1990 --- os2/perlglob.cs Tue Oct 16 11:56:14 1990 *************** *** 0 **** --- 1,7 ---- + glob.c + + setargv.obj + perlglob.def + perlglob.exe + + -AS -LB -S0x1000 Index: os2/perlglob.def *** os2/perlglob.def.old Tue Oct 16 11:56:21 1990 --- os2/perlglob.def Tue Oct 16 11:56:24 1990 *************** *** 0 **** --- 1,3 ---- + NAME PERLGLOB WINDOWCOMPAT NEWFILES + DESCRIPTION 'Filename globbing for PERL - for MS-DOS and OS/2' + STUB 'REALGLOB.EXE' Index: os2/perlsh.cmd *** os2/perlsh.cmd.old Tue Oct 16 11:56:33 1990 --- os2/perlsh.cmd Tue Oct 16 11:56:35 1990 *************** *** 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: stab.h Prereq: 3.0.1.3 *** stab.h.old Tue Oct 16 12:03:08 1990 --- stab.h Tue Oct 16 12:03:11 1990 *************** *** 1,4 **** ! /* $Header: stab.h,v 3.0.1.3 90/08/09 05:18:42 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: stab.h,v 3.0.1.4 90/10/16 10:33:08 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * 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,32 **** --- 31,37 ---- 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,62 **** --- 62,68 ---- ((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,99 **** CMD *cmd; int (*usersub)(); int userindex; ! char *filename; long depth; /* >= 2 indicates recursive call */ ARRAY *tosave; }; --- 99,105 ---- CMD *cmd; int (*usersub)(); int userindex; ! STAB *filestab; long depth; /* >= 2 indicates recursive call */ ARRAY *tosave; }; *************** *** 117,119 **** --- 123,126 ---- STAB *aadd(); STAB *hadd(); + STAB *fstab(); *** End of Patch 33 ***