perl 3.0 patch #18 patch #16, continued

See patch #16.

22 files changed, 817 insertions, 64 deletions

diff --git a/arg.h b/arg.h
index 1082142d4e..2406cb9e46 100644
--- a/arg.h
+++ b/arg.h
@@ -1,4 +1,4 @@
-/* $Header: arg.h,v 3.0.1.4 90/03/12 16:18:21 lwall Locked $
+/* $Header: arg.h,v 3.0.1.5 90/03/27 15:29:41 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	arg.h,v $
+ * Revision 3.0.1.5  90/03/27  15:29:41  lwall
+ * patch16: MSDOS support
+ * 
  * Revision 3.0.1.4  90/03/12  16:18:21  lwall
  * patch13: added list slice operator (LIST)[LIST]
  * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
@@ -267,7 +270,8 @@
 #define O_GETPEERNAME 240
 #define O_LSLICE 241
 #define O_SPLICE 242
-#define MAXO 243
+#define O_BINMODE 243
+#define MAXO 244
 
 #ifndef DOINIT
 extern char *opname[];
@@ -516,7 +520,8 @@ char *opname[] = {
     "GETPEERNAME",
     "LSLICE",
     "SPLICE",
-    "243"
+    "BINMODE",
+    "244"
 };
 #endif
 
@@ -892,6 +897,7 @@ char opargs[MAXO+1] = {
 	A(1,0,0),	/* GETPEERNAME */
 	A(0,3,3),	/* LSLICE */
 	A(0,3,1),	/* SPLICE */
+	A(1,0,0),	/* BINMODE */
 	0
 };
 #undef A
diff --git a/cons.c b/cons.c
index 5515066930..37186852d8 100644
--- a/cons.c
+++ b/cons.c
@@ -1,4 +1,4 @@
-/* $Header: cons.c,v 3.0.1.5 90/03/12 16:23:10 lwall Locked $
+/* $Header: cons.c,v 3.0.1.6 90/03/27 15:35:21 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:	cons.c,v $
+ * Revision 3.0.1.6  90/03/27  15:35:21  lwall
+ * patch16: formats didn't work inside eval
+ * patch16: $foo++ now optimized to ++$foo where value not required
+ * 
  * Revision 3.0.1.5  90/03/12  16:23:10  lwall
  * patch13: perl -d coredumped on scripts with subs that did explicit return
  * 
@@ -95,6 +99,28 @@ CMD *cmd;
     return sub;
 }
 
+make_form(stab,fcmd)
+STAB *stab;
+FCMD *fcmd;
+{
+    if (stab_form(stab)) {
+	FCMD *tmpfcmd;
+	FCMD *nextfcmd;
+
+	for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
+	    nextfcmd = tmpfcmd->f_next;
+	    if (tmpfcmd->f_expr)
+		arg_free(tmpfcmd->f_expr);
+	    if (tmpfcmd->f_unparsed)
+		str_free(tmpfcmd->f_unparsed);
+	    if (tmpfcmd->f_pre)
+		Safefree(tmpfcmd->f_pre);
+	    Safefree(tmpfcmd);
+	}
+    }
+    stab_form(stab) = fcmd;
+}
+
 CMD *
 block_head(tail)
 register CMD *tail;
@@ -594,6 +620,10 @@ int acmd;
 
     if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
 	cmd->c_flags |= opt;
+	if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)) {
+	    arg[flp].arg_flags &= ~AF_POST;	/* prefer ++$foo to $foo++ */
+	    arg[flp].arg_flags |= AF_PRE;	/*  if value not wanted */
+	}
 	return;				/* side effect, can't optimize */
     }
 
diff --git a/lib/syslog.pl b/lib/syslog.pl
new file mode 100644
index 0000000000..46c8c86eda
--- /dev/null
+++ b/lib/syslog.pl
@@ -0,0 +1,148 @@
+#
+# syslog.pl
+#
+# tom christiansen <tchrist@convex.com>
+# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
+# NOTE: openlog now takes three arguments, just like openlog(3)
+#
+# call syslog() with a string priority and a list of printf() args
+# like syslog(3)
+#
+#  usage: do 'syslog.pl' || die "syslog.pl: $@";
+#
+#  then (put these all in a script to test function)
+#		
+#
+#	do openlog($program,'cons,pid','user');
+#	do syslog('info','this is another test');
+#	do syslog('warn','this is a better test: %d', time);
+#	do closelog();
+#	
+#	do syslog('debug','this is the last test');
+#	do openlog("$program $$",'ndelay','user');
+#	do syslog('notice','fooprogram: this is really done');
+#
+#	$! = 55;
+#	do syslog('info','problem was %m'); # %m == $! in syslog(3)
+
+package syslog;
+
+$host = 'localhost' unless $host;	# set $syslog'host to change
+
+do '/usr/local/lib/perl/syslog.h'
+	|| die "syslog: Can't do syslog.h: ",($@||$!),"\n";
+
+sub main'openlog {
+    ($ident, $logopt, $facility) = @_;  # package vars
+    $lo_pid = $logopt =~ /\bpid\b/;
+    $lo_ndelay = $logopt =~ /\bndelay\b/;
+    $lo_cons = $logopt =~ /\bncons\b/;
+    $lo_nowait = $logopt =~ /\bnowait\b/;
+    &connect if $lo_ndelay;
+} 
+
+sub main'closelog {
+    $facility = $ident = '';
+    &disconnect;
+} 
+ 
+sub main'syslog {
+    local($priority) = shift;
+    local($mask) = shift;
+    local($message, $whoami);
+
+    &connect unless $connected;
+
+    $whoami = $ident;
+
+    die "syslog: expected both priority and mask" unless $mask && $priority;
+
+    $facility = "user" unless $facility;
+
+    if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
+	$whoami = $1;
+	$mask = $2;
+    } 
+    $whoami .= " [$$]" if $lo_pid;
+
+    $mask =~ s/%m/$!/g;
+    $mask .= "\n" unless $mask =~ /\n$/;
+    $message = sprintf ($mask, @_);
+
+    $whoami = sprintf ("%s %d",$ENV{'USER'}||$ENV{'LOGNAME'},$$) unless $whoami;
+
+    $sum = &xlate($priority) + &xlate($facility);
+    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
+	if ($lo_cons) {
+	    if ($pid = fork) {
+		unless ($lo_nowait) {
+		    do {$died = wait;} until $died == $pid || $died < 0;
+		}
+	    }
+	    else {
+		open(CONS,">/dev/console");
+		print CONS "$<facility.$priority>$whoami: $message\n";
+		exit if defined $pid;		# if fork failed, we're parent
+		close CONS;
+	    }
+	}
+    }
+}
+
+sub xlate {
+    local($name) = @_;
+    $name =~ y/a-z/A-Z/;
+    $name = "LOG_$name" unless $name =~ /^LOG_/;
+    $name = "syslog'$name";
+    &$name;
+}
+
+sub connect {
+    $pat = 'S n C4 x8';
+
+    $af_unix = 1;
+    $af_inet = 2;
+
+    $stream = 1;
+    $datagram = 2;
+
+    ($name,$aliases,$proto) = getprotobyname('udp');
+    $udp = $proto;
+
+    ($name,$aliase,$port,$proto) = getservbyname('syslog','udp');
+    $syslog = $port;
+
+    if (chop($myname = `hostname`)) {
+	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
+	die "Can't lookup $myname\n" unless $name;
+	@bytes = unpack("C4",$addrs[0]);
+    }
+    else {
+	@bytes = (0,0,0,0);
+    }
+    $this = pack($pat, $af_inet, 0, @bytes);
+
+    if ($host =~ /^\d+\./) {
+	@bytes = split(/\./,$host);
+    }
+    else {
+	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
+	die "Can't lookup $host\n" unless $name;
+	@bytes = unpack("C4",$addrs[0]);
+    }
+    $that = pack($pat,$af_inet,$syslog,@bytes);
+
+    socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
+    bind(SYSLOG,$this) || die "bind: $!\n";
+    connect(SYSLOG,$that) || die "connect: $!\n";
+
+    local($old) = select(SYSLOG); $| = 1; select($old);
+    $connected = 1;
+}
+
+sub disconnect {
+    close SYSLOG;
+    $connected = 0;
+}
+
+1;
diff --git a/msdos/README.msdos b/msdos/README.msdos
new file mode 100644
index 0000000000..fb7be1afe4
--- /dev/null
+++ b/msdos/README.msdos
@@ -0,0 +1,100 @@
+		   Notes on the MS-DOS Perl port
+
+			Diomidis Spinellis
+			 (dds@cc.ic.ac.uk)
+
+[0. First copy the files in the msdos directory into the parent
+directory--law]
+
+1.  Compiling.
+
+     Perl has been compiled under MS-DOS using the Microsoft
+C  compiler  version 5.1.  Before compiling install dir.h as
+<sys/dir.h>.  You will need a Unix-like make  program  (e.g.
+pdmake) and something like yacc (e.g. bison).  You could get
+away by running yacc and dry running make on  a  Unix  host,
+but  I  haven't tried it.  Compilation takes 12 minutes on a
+20MHz 386 machine (together with formating the  manual),  so
+you  will probably need something to do in the meantime. The
+executable is 272k and the top level directory needs 1M  for
+sources  and  about the same ammount for the object code and
+the executables.
+
+     The makefile will compile glob for you which  you  will
+need  to  place somewhere in your path so that perl globbing
+will work correctly.  I have not tried all the tests or  the
+examples,  nor the awk and sed to Perl translators.  You are
+on your own with them.  In the eg directory I have  included
+an  example  program  that uses ioctl to display the charac-
+teristics of the storage devices of the system.
+
+2.  Using MS-DOS Perl
+
+     The MS-DOS version of perl has most of the  functional-
+ity of the Unix version.  Functions that can not be provided
+under  MS-DOS  like  sockets,  password  and  host  database
+access,  fork  and wait have been ommited and will terminate
+with a fatal error.  Care has been taken  to  implement  the
+rest.   In particular directory access, redirection (includ-
+ing pipes, but excluding the pipe function),  system,  ioctl
+and sleep have been provided.
+
+2.1.  Interface to the MS-DOS ioctl system call.
+
+     The function code of the  ioctl  function  (the  second
+argument) is encoded as follows:
+
+- The lowest nibble of the function code goes to AL.
+- The two middle nibbles go to CL.
+- The high nibble goes to CH.
+
+     The return code is -1 in the case of an  error  and  if
+successful:
+
+- for functions AL = 00, 09, 0a the value of the register DX
+- for functions AL = 02 - 08, 0e the value of the register AX
+- for functions AL = 01, 0b - 0f the number 0.
+
+     See the perl manual for instruction on how  to  distin-
+guish between the return value and the success of ioctl.
+
+     Some ioctl functions need a number as the  first  argu-
+ment.   Provided  that  no  other files have been opened the
+number  can  be   obtained   if   ioctl   is   called   with
+@fdnum[number]  as  the  first  argument after executing the
+following code:
+
+        @fdnum = ("STDIN", "STDOUT", "STDERR");
+        $maxdrives = 15;
+        for ($i = 3; $i < $maxdrives; $i++) {
+                open("FD$i", "nul");
+                @fdnum[$i - 1] = "FD$i";
+        }
+
+2.2.  Binary file access
+
+     Files are opened in text mode by default.   This  means
+that  CR LF pairs are translated to LF.  If binary access is
+needed the `binary'  function  should  be  used.   There  is
+currently  no  way to reverse the effect of the binary func-
+tion.  If that is needed close and reopen the file.
+
+2.3.  Interpreter startup.
+
+     The effect of the Unix #!/bin/perl interpreter  startup
+can  be  obtained  under  MS-DOS by giving the script a .bat
+extension and using the following lines on its begining:
+
+        @REM=("
+        @perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+        @end ") if 0 ;
+
+(Note that you will probably want an absolute path name in
+front of %0.bat).
+
+				March 1990
+
+				Diomidis Spinellis <dds@cc.ic.ac.uk>
+				Myrsinis 1
+				GR-145 62 Kifissia
+				Greece
diff --git a/msdos/eg/drives.bat b/msdos/eg/drives.bat
new file mode 100644
index 0000000000..c68306ed8d
--- /dev/null
+++ b/msdos/eg/drives.bat
@@ -0,0 +1,41 @@
+@REM=("
+@perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+@end ") if 0 ;
+
+#
+# Test the ioctl function for MS-DOS.  Provide a list of drives and their
+# characteristics.
+#
+# By Diomidis Spinellis.
+#
+
+@fdnum = ("STDIN", "STDOUT", "STDERR");
+$maxdrives = 15;
+for ($i = 3; $i < $maxdrives; $i++) {
+	open("FD$i", "nul");
+	@fdnum[$i - 1] = "FD$i";
+}
+@mediatype = (
+	"320/360 k floppy drive",
+	"1.2M floppy",
+	"720K floppy",
+	"8'' single density floppy",
+	"8'' double density floppy",
+	"fixed disk",
+	"tape drive",
+	"1.44M floppy",
+	"other"
+);
+print "The system has the following drives:\n";
+for ($i = 1; $i < $maxdrives; $i++) {
+	if ($ret = ioctl(@fdnum[$i], 8, 0)) {
+		$type = ($ret == 0) ? "removable" : "fixed";
+		$ret = ioctl(@fdnum[$i], 9, 0);
+		$location = ($ret & 0x800) ? "local" : "remote";
+		ioctl(@fdnum[$i], 0x860d, $param);
+		@par = unpack("CCSSSC31S", $param);
+		$lock = (@par[2] & 2) ? "supporting door lock" : "not supporting door lock";
+		printf "%c:$type $location @mediatype[@par[1]] @par[3] cylinders @par[6]
+ sectors/track $lock\n", ord('A') + $i - 1;
+	}
+}
diff --git a/msdos/popen.c b/msdos/popen.c
new file mode 100644
index 0000000000..60b21790fc
--- /dev/null
+++ b/msdos/popen.c
@@ -0,0 +1,175 @@
+/* $Header: popen.c,v 3.0.1.1 90/03/27 16:11:57 lwall Locked $
+ *
+ *    (C) Copyright 1988, 1990 Diomidis Spinellis.
+ *
+ *    You may distribute under the terms of the GNU General Public License
+ *    as specified in the README file that comes with the perl 3.0 kit.
+ *
+ * $Log:	popen.c,v $
+ * Revision 3.0.1.1  90/03/27  16:11:57  lwall
+ * patch16: MSDOS support
+ * 
+ * Revision 1.1  90/03/18  20:32:20  dds
+ * Initial revision
+ *
+ */
+
+/*
+ * Popen and pclose for MS-DOS
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <process.h>
+
+/*
+ * Possible actions on an popened file
+ */
+enum action {
+	delete, 			/* Used for "r". Delete the tmp file */
+	execute				/* Used for "w". Execute the command. */
+};
+
+/*
+ * Linked list of things to do at the end of the program execution.
+ */
+static struct todo {
+	FILE *f;			/* File we are working on (to fclose) */
+	const char *name;		/* Name of the file (to unlink) */
+	const char *command;		/* Command to execute */
+	enum action what;		/* What to do (execute or delete) */
+	struct todo *next;		/* Next structure */
+} *todolist;
+
+
+/* Clean up function */
+static int close_pipes(void);
+
+/*
+ * Add a file f running the command command on file name to the list
+ * of actions to be done at the end.  The action is specified in what.
+ * Return -1 on failure, 0 if ok.
+ */
+static int
+add(FILE *f, const char *command, const char *name, enum action what)
+{
+	struct todo    *p;
+
+	if ((p = (struct todo *) malloc(sizeof(struct todo))) == NULL)
+		return -1;
+	p->f = f;
+	p->command = command;
+	p->name = name;
+	p->what = what;
+	p->next = todolist;
+	todolist = p;
+	return 0;
+}
+
+FILE *
+mypopen(const char *command, const char *t)
+{
+	char buff[256];
+	char *name;
+	FILE *f;
+	static init = 0;
+
+	if (!init)
+		if (onexit(close_pipes) == NULL)
+			return NULL;
+		else
+			init++;
+
+	if ((name = tempnam(getenv("TMP"), "pp")) == NULL)
+		return NULL;
+
+	switch (*t) {
+	case 'r':
+		sprintf(buff, "%s >%s", command, name);
+		if (system(buff) || (f = fopen(name, "r")) == NULL) {
+			free(name);
+			return NULL;
+		}
+		if (add(f, command, name, delete)) {
+			(void)fclose(f);
+			(void)unlink(name);
+			free(name);
+			return NULL;
+		}
+		return f;
+	case 'w':
+		if ((f = fopen(name, "w")) == NULL) {
+			free(name);
+			return NULL;
+		}
+		if (add(f, command, name, execute)) {
+			(void)fclose(f);
+			(void)unlink(name);
+			free(name);
+			return NULL;
+		}
+		return f;
+	default:
+		free(name);
+		return NULL;
+	}
+}
+
+int
+mypclose(FILE *f)
+{
+	struct todo *p, **prev;
+	char buff[256];
+	const char *name;
+	int status;
+
+	for (p = todolist, prev = &todolist; p; prev = &(p->next), p = p->next)
+		if (p->f == f) {
+			*prev = p->next;
+			name = p->name;
+			switch (p->what) {
+			case delete:
+				free(p);
+				if (fclose(f) == EOF) {
+					(void)unlink(name);
+					status = EOF;
+				} else if (unlink(name) < 0)
+					status = EOF;
+				else
+					status = 0;
+				free(name);
+				return status;
+			case execute:
+				(void)sprintf(buff, "%s <%s", p->command, p->name);
+				free(p);
+				if (system(buff)) {
+					(void)unlink(name);
+					status = EOF;
+				} else if (fclose(f) == EOF) {
+					(void)unlink(name);
+					status = EOF;
+				} else if (unlink(name) < 0)
+					status = EOF;
+				else
+					status = 0;
+				free(name);
+				return status;
+			default:
+				return EOF;
+			}
+		}
+	return EOF;
+}
+
+/*
+ * Clean up at the end.  Called by the onexit handler.
+ */
+static int
+close_pipes(void)
+{
+	struct todo    *p;
+
+	for (p = todolist; p; p = p->next)
+		(void)mypclose(p->f);
+	return 0;
+}
diff --git a/patchlevel.h b/patchlevel.h
index 6dbf0692d5..1af605efed 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 17
+#define PATCHLEVEL 18
diff --git a/perl.h b/perl.h
index 0828407c67..65738a1265 100644
--- a/perl.h
+++ b/perl.h
@@ -1,4 +1,4 @@
-/* $Header: perl.h,v 3.0.1.6 90/03/12 16:40:43 lwall Locked $
+/* $Header: perl.h,v 3.0.1.7 90/03/27 16:12:52 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:	perl.h,v $
+ * Revision 3.0.1.7  90/03/27  16:12:52  lwall
+ * patch16: MSDOS support
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * 
  * Revision 3.0.1.6  90/03/12  16:40:43  lwall
  * patch13: did some ndir straightening up for Xenix
  * 
@@ -49,6 +53,51 @@
 #define VOIDUSED 1
 #include "config.h"
 
+#ifdef MSDOS
+/*
+ * BUGGY_MSC:
+ *	This symbol is defined if you are the unfortunate owner of a buggy
+ *	Microsoft C compiler and want to use intrinsic functions.  Versions
+ *	up to 5.1 are known conform to this definition.  This is not needed
+ *	under Unix.
+ */
+#define BUGGY_MSC			/**/
+/*
+ * BINARY:
+ *	This symbol is defined if you run under an operating system that
+ *	distinguishes between binary and text files.  If so the function
+ *	setmode will be used to set the file into binary mode.  Unix
+ *	doesn't distinguish.
+ */
+#define BINARY				/**/
+
+#else /* !MSDOS */
+
+/*
+ * The following symbols are defined if your operating system supports
+ * functions by that name.  All Unixes I know of support them, thus they
+ * are not checked by the configuration script, but are directly defined
+ * here.
+ */
+#define CHOWN
+#define CHROOT
+#define FORK
+#define GETLOGIN
+#define GETPPID
+#define KILL
+#define LINK
+#define PIPE
+#define WAIT
+#define UMASK
+/*
+ * The following symbols are defined if your operating system supports
+ * password and group functions in general.  All Unix systems do.
+ */
+#define GROUP
+#define PASSWD
+
+#endif /* !MSDOS */
+
 #if defined(HASVOLATILE) || defined(__STDC__)
 #define VOLATILE volatile
 #else
@@ -244,7 +293,7 @@ typedef struct stab STAB;
 #include "array.h"
 #include "hash.h"
 
-#if defined(iAPX286) || defined(M_I286) || defined(I80286)
+#if defined(iAPX286) || defined(M_I286) || defined(I80286) || defined(M_I86)
 #   define I286
 #endif
 
@@ -351,6 +400,17 @@ EXT STR *Str;
 #endif
 #endif
 
+#ifdef CASTNEGFLOAT
+#define U_S(what) ((unsigned short)(what))
+#define U_I(what) ((unsigned int)(what))
+#define U_L(what) ((unsigned long)(what))
+#else
+unsigned long castulong();
+#define U_S(what) ((unsigned int)castulong(what))
+#define U_I(what) ((unsigned int)castulong(what))
+#define U_L(what) (castulong(what))
+#endif
+
 CMD *add_label();
 CMD *block_head();
 CMD *append_line();
diff --git a/perl.man.1 b/perl.man.1
index dea4da6cfe..69f373ffe4 100644
--- a/perl.man.1
+++ b/perl.man.1
@@ -1,7 +1,10 @@
 .rn '' }`
-''' $Header: perl.man.1,v 3.0.1.4 90/03/12 16:44:33 lwall Locked $
+''' $Header: perl_man.1,v 3.0.1.5 90/03/27 16:14:37 lwall Locked $
 ''' 
 ''' $Log:	perl.man.1,v $
+''' Revision 3.0.1.5  90/03/27  16:14:37  lwall
+''' patch16: .. now works using magical string increment
+''' 
 ''' Revision 3.0.1.4  90/03/12  16:44:33  lwall
 ''' patch13: (LIST,) now legal
 ''' patch13: improved LIST documentation
@@ -1450,3 +1453,22 @@ as a string, preserving each character within its range, with carry:
 
 .fi
 The autodecrement is not magical.
+.PP
+The range operator (in an array context) makes use of the magical
+autoincrement algorithm if the minimum and maximum are strings.
+You can say
+
+	@alphabet = (\'A\' .. \'Z\');
+
+to get all the letters of the alphabet, or
+
+	$hexdigit = (0 .. 9, \'a\' .. \'f\')[$num & 15];
+
+to get a hexadecimal digit, or
+
+	@z2 = (\'01\' .. \'31\');  print @z2[$mday];
+
+to get dates with leading zeros.
+(If the final value specified is not in the sequence that the magical increment
+would produce, the sequence goes until the next value would be longer than
+the final value specified.)
diff --git a/perl.man.2 b/perl.man.2
index 722dc8adb0..4f637f1db0 100644
--- a/perl.man.2
+++ b/perl.man.2
@@ -1,7 +1,10 @@
 ''' Beginning of part 2
-''' $Header: perl.man.2,v 3.0.1.4 90/03/12 16:46:02 lwall Locked $
+''' $Header: perl_man.2,v 3.0.1.5 90/03/27 16:15:17 lwall Locked $
 '''
 ''' $Log:	perl.man.2,v $
+''' Revision 3.0.1.5  90/03/27  16:15:17  lwall
+''' patch16: MSDOS support
+''' 
 ''' Revision 3.0.1.4  90/03/12  16:46:02  lwall
 ''' patch13: documented behavior of @array = /noparens/
 ''' 
@@ -62,6 +65,15 @@ See example in section on Interprocess Communication.
 Returns the arctangent of X/Y in the range
 .if t \-\(*p to \(*p.
 .if n \-PI to PI.
+.Ip "binmode(FILEHANDLE)" 8 4
+.Ip "binmode FILEHANDLE" 8 4
+Arranges for the file to be read in \*(L"binary\*(R" mode in operating systems
+that distinguish between binary and text files.
+Files that are not read in binary mode have CR LF sequences translated
+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 "bind(SOCKET,NAME)" 8 2
 Does the same thing that the bind system call does.
 Returns true if it succeeded, false otherwise.
diff --git a/perl.man.3 b/perl.man.3
index 35a9c02270..e748679844 100644
--- a/perl.man.3
+++ b/perl.man.3
@@ -1,7 +1,10 @@
 ''' Beginning of part 3
-''' $Header: perl.man.3,v 3.0.1.5 90/03/12 16:52:21 lwall Locked $
+''' $Header: perl_man.3,v 3.0.1.6 90/03/27 16:17:56 lwall Locked $
 '''
 ''' $Log:	perl.man.3,v $
+''' Revision 3.0.1.6  90/03/27  16:17:56  lwall
+''' patch16: MSDOS support
+''' 
 ''' Revision 3.0.1.5  90/03/12  16:52:21  lwall
 ''' patch13: documented that print $filehandle &foo is ambiguous
 ''' patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
@@ -235,7 +238,7 @@ Returns true if successful.
 DIRHANDLEs have their own namespace separate from FILEHANDLEs.
 .Ip "ord(EXPR)" 8 4
 .Ip "ord EXPR" 8
-Returns the ascii value of the first character of EXPR.
+Returns the numeric ascii value of the first character of EXPR.
 If EXPR is omitted, uses $_.
 .Ip "pack(TEMPLATE,LIST)" 8 4
 Takes an array or list of values and packs it into a binary structure,
diff --git a/perl.man.4 b/perl.man.4
index 4269559b90..77a8a00597 100644
--- a/perl.man.4
+++ b/perl.man.4
@@ -1,7 +1,10 @@
 ''' Beginning of part 4
-''' $Header: perl.man.4,v 3.0.1.7 90/03/14 12:29:50 lwall Locked $
+''' $Header: perl_man.4,v 3.0.1.8 90/03/27 16:19:31 lwall Locked $
 '''
 ''' $Log:	perl.man.4,v $
+''' Revision 3.0.1.8  90/03/27  16:19:31  lwall
+''' patch16: MSDOS support
+''' 
 ''' Revision 3.0.1.7  90/03/14  12:29:50  lwall
 ''' patch15: man page falsely states that you can't subscript array values
 ''' 
@@ -504,7 +507,7 @@ Here is a sample client (untested):
 
 	($name, $aliases, $proto) = getprotobyname('tcp');
 	($name, $aliases, $port) = getservbyname($port, 'tcp')
-		unless $port =~ /^\ed+$/;;
+		unless $port =~ /^\ed+$/;
 .ie t \{\
 	($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
 'br\}
@@ -549,7 +552,7 @@ And here's a server:
 
 	($name, $aliases, $proto) = getprotobyname('tcp');
 	($name, $aliases, $port) = getservbyname($port, 'tcp')
-		unless $port =~ /^\ed+$/;;
+		unless $port =~ /^\ed+$/;
 
 	$this = pack($sockaddr, &AF_INET, $port, "\e0\e0\e0\e0");
 
@@ -1318,6 +1321,8 @@ before doing anything else, just to keep people honest:
 .fi
 .SH AUTHOR
 Larry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov>
+.br
+MS-DOS port by Diomidis Spinellis <dds@cc.ic.ac.uk>
 .SH FILES
 /tmp/perl\-eXXXXXX	temporary file for
 .B \-e
diff --git a/perl.y b/perl.y
index 96ef414c43..7ceb2d7eba 100644
--- a/perl.y
+++ b/perl.y
@@ -1,4 +1,4 @@
-/* $Header: perl.y,v 3.0.1.5 90/03/12 16:55:56 lwall Locked $
+/* $Header: perl.y,v 3.0.1.6 90/03/27 16:13:45 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	perl.y,v $
+ * Revision 3.0.1.6  90/03/27  16:13:45  lwall
+ * patch16: formats didn't work inside eval
+ * 
  * Revision 3.0.1.5  90/03/12  16:55:56  lwall
  * patch13: added list slice operator (LIST)[LIST]
  * patch13: (LIST,) now legal
@@ -67,7 +70,6 @@ ARG *arg5;
 %token <arg> RSTRING TRANS
 
 %type <ival> prog decl format remember
-%type <stabval>
 %type <cmdval> block lineseq line loop cond sideff nexpr else
 %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
 %type <arg> texpr listop
@@ -307,14 +309,14 @@ decl	:	format
 
 format	:	FORMAT WORD '=' FORMLIST
 			{ if (strEQ($2,"stdout"))
-			    stab_form(stabent("STDOUT",TRUE)) = $4;
+			    make_form(stabent("STDOUT",TRUE),$4);
 			  else if (strEQ($2,"stderr"))
-			    stab_form(stabent("STDERR",TRUE)) = $4;
+			    make_form(stabent("STDERR",TRUE),$4);
 			  else
-			    stab_form(stabent($2,TRUE)) = $4;
+			    make_form(stabent($2,TRUE),$4);
 			  Safefree($2);}
 	|	FORMAT '=' FORMLIST
-			{ stab_form(stabent("STDOUT",TRUE)) = $3; }
+			{ make_form(stabent("STDOUT",TRUE),$3); }
 	;
 
 subrout	:	SUB WORD block
diff --git a/perly.c b/perly.c
index d0aec550e6..ad0075f096 100644
--- a/perly.c
+++ b/perly.c
@@ -1,4 +1,4 @@
-char rcsid[] = "$Header: perly.c,v 3.0.1.4 90/02/28 18:06:41 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.5 90/03/27 16:20:57 lwall Locked $\nPatch level: ###\n";
 /*
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,10 @@ char rcsid[] = "$Header: perly.c,v 3.0.1.4 90/02/28 18:06:41 lwall Locked $\nPat
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	perly.c,v $
+ * Revision 3.0.1.5  90/03/27  16:20:57  lwall
+ * patch16: MSDOS support
+ * patch16: do FILE inside eval blows up
+ * 
  * Revision 3.0.1.4  90/02/28  18:06:41  lwall
  * patch9: perl can now start up other interpreters scripts
  * patch9: nested evals clobbered their longjmp environment
@@ -71,6 +75,15 @@ setuid perl scripts securely.\n");
     euid = (int)geteuid();
     gid = (int)getgid();
     egid = (int)getegid();
+#ifdef MSDOS
+    /*
+     * There is no way we can refer to them from Perl so close them to save
+     * space.  The other alternative would be to provide STDAUX and STDPRN
+     * filehandles.
+     */
+    (void)fclose(stdaux);
+    (void)fclose(stdprn);
+#endif
     if (do_undump) {
 	do_undump = 0;
 	loop_ptr = -1;		/* start label stack again */
@@ -195,7 +208,12 @@ setuid perl scripts securely.\n");
 	    goto reswitch;
 	case 'v':
 	    fputs(rcsid,stdout);
-	    fputs("\nCopyright (c) 1989, Larry Wall\n\n\
+	    fputs("\nCopyright (c) 1989, 1990, Larry Wall\n",stdout);
+#ifdef MSDOS
+	    fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
+	    stdout);
+#endif
+	    fputs("\n\
 Perl may be copied only under the terms of the GNU General Public License,\n\
 a copy of which can be found with the Perl 3.0 distribution kit.\n",stdout);
 	    exit(0);
@@ -748,7 +766,7 @@ int *arglast;
 	str_cat(linestr,";");		/* be kind to them */
     }
     else {
-	if (last_root) {
+	if (last_root && !in_eval) {
 	    Safefree(last_eval);
 	    cmd_free(last_root);
 	    last_root = Nullcmd;
diff --git a/stab.c b/stab.c
index 9d252bb3b9..30b797bbb6 100644
--- a/stab.c
+++ b/stab.c
@@ -1,4 +1,4 @@
-/* $Header: stab.c,v 3.0.1.5 90/03/12 17:00:11 lwall Locked $
+/* $Header: stab.c,v 3.0.1.6 90/03/27 16:22:11 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	stab.c,v $
+ * Revision 3.0.1.6  90/03/27  16:22:11  lwall
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * 
  * Revision 3.0.1.5  90/03/12  17:00:11  lwall
  * patch13: undef $/ didn't work as advertised
  * 
@@ -342,7 +345,7 @@ STR *str;
 	    arybase = (int)str_gnum(str);
 	    break;
 	case '?':
-	    statusvalue = (unsigned short)str_gnum(str);
+	    statusvalue = U_S(str_gnum(str));
 	    break;
 	case '!':
 	    errno = (int)str_gnum(str);		/* will anyone ever use this? */
diff --git a/str.c b/str.c
index bbea53ef56..324e10065c 100644
--- a/str.c
+++ b/str.c
@@ -1,4 +1,4 @@
-/* $Header: str.c,v 3.0.1.6 90/03/12 17:02:14 lwall Locked $
+/* $Header: str.c,v 3.0.1.7 90/03/27 16:24:11 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:	str.c,v $
+ * Revision 3.0.1.7  90/03/27  16:24:11  lwall
+ * patch16: strings with prefix chopped off sometimes freed wrong
+ * patch16: taint check blows up on undefined array element
+ * 
  * Revision 3.0.1.6  90/03/12  17:02:14  lwall
  * patch13: substr as lvalue didn't invalidate old numeric value
  * 
@@ -122,9 +126,13 @@ str_numset(str,num)
 register STR *str;
 double num;
 {
+    if (str->str_pok) {
+	str->str_pok = 0;	/* invalidate pointer */
+	if (str->str_state == SS_INCR)
+	    str_grow(str,0);
+    }
     str->str_u.str_nval = num;
     str->str_state = SS_NORM;
-    str->str_pok = 0;	/* invalidate pointer */
     str->str_nok = 1;			/* validate number */
 #ifdef TAINT
     str->str_tainted = tainted;
@@ -197,6 +205,8 @@ register STR *str;
 {
     if (!str)
 	return 0.0;
+    if (str->str_state == SS_INCR)
+	str_grow(str,0);       /* just force copy down */
     str->str_state = SS_NORM;
     if (str->str_len && str->str_pok)
 	str->str_u.str_nval = atof(str->str_ptr);
@@ -220,7 +230,8 @@ STR *dstr;
 register STR *sstr;
 {
 #ifdef TAINT
-    tainted |= sstr->str_tainted;
+    if (sstr)
+	tainted |= sstr->str_tainted;
 #endif
     if (sstr == dstr)
 	return;
@@ -245,6 +256,9 @@ register STR *sstr;
     else if (sstr->str_nok)
 	str_numset(dstr,sstr->str_u.str_nval);
     else {
+	if (dstr->str_state == SS_INCR)
+	    str_grow(dstr,0);       /* just force copy down */
+
 #ifdef STRUCTCOPY
 	dstr->str_u = sstr->str_u;
 #else
@@ -260,7 +274,8 @@ register char *ptr;
 register int len;
 {
     STR_GROW(str, len + 1);
-    (void)bcopy(ptr,str->str_ptr,len);
+    if (ptr)
+	(void)bcopy(ptr,str->str_ptr,len);
     str->str_cur = len;
     *(str->str_ptr+str->str_cur) = '\0';
     str->str_nok = 0;		/* invalidate number */
diff --git a/t/op.dbm b/t/op.dbm
index dd0a4523ce..1f807153ac 100644
--- a/t/op.dbm
+++ b/t/op.dbm
@@ -1,13 +1,13 @@
 #!./perl
 
-# $Header: op.dbm,v 3.0 89/10/18 15:28:31 lwall Locked $
+# $Header: op.dbm,v 3.0.1.1 90/03/27 16:25:57 lwall Locked $
 
 if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h') {
     print "1..0\n";
     exit;
 }
 
-print "1..9\n";
+print "1..10\n";
 
 unlink 'Op.dbmx.dir', 'Op.dbmx.pag';
 umask(0);
@@ -92,4 +92,8 @@ print ($ok ? "ok 8\n" : "not ok 8\n");
    $blksize,$blocks) = stat('Op.dbmx.pag');
 print ($size > 0 ? "ok 9\n" : "not ok 9\n");
 
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "no ok 10\n";
+
 unlink 'Op.dbmx.dir', 'Op.dbmx.pag';
diff --git a/t/op.range b/t/op.range
index 4975c44441..d581b433cf 100644
--- a/t/op.range
+++ b/t/op.range
@@ -1,8 +1,8 @@
 #!./perl
 
-# $Header: op.range,v 3.0 89/10/18 15:30:53 lwall Locked $
+# $Header: op.range,v 3.0.1.1 90/03/27 16:27:58 lwall Locked $
 
-print "1..6\n";
+print "1..8\n";
 
 print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
 
@@ -28,3 +28,9 @@ for ((100,2..99,1)) {
     $x += $_;
 }
 print $x == 5050 ? "ok 6\n" : "not ok 6 $x\n";
+
+$x = join('','a'..'z');
+print $x eq 'abcdefghijklmnopqrstuvwxyz' ? "ok 7\n" : "not ok 7 $x\n";
+
+@x = 'A'..'ZZ';
+print @x == 27 * 26 ? "ok 8\n" : "not ok 8\n";
diff --git a/t/op.subst b/t/op.subst
index a3d45ea506..97ca2f8293 100644
--- a/t/op.subst
+++ b/t/op.subst
@@ -1,6 +1,6 @@
 #!./perl
 
-# $Header: op.subst,v 3.0.1.1 90/02/28 18:37:30 lwall Locked $
+# $Header: op.s,v 3.0.1.1 90/02/28 18:37:30 lwall Locked $
 
 print "1..42\n";
 
diff --git a/t/op.write b/t/op.write
index e1da85cc04..ef806da5b1 100644
--- a/t/op.write
+++ b/t/op.write
@@ -1,8 +1,8 @@
 #!./perl
 
-# $Header: op.write,v 3.0 89/10/18 15:32:16 lwall Locked $
+# $Header: op.write,v 3.0.1.1 90/03/27 16:29:00 lwall Locked $
 
-print "1..2\n";
+print "1..3\n";
 
 format OUT =
 the quick brown @<<
@@ -85,3 +85,45 @@ if (`cat Op.write.tmp` eq $right)
 else
     { print "not ok 2\n"; }
 
+eval <<'EOFORMAT';
+format OUT2 =
+the brown quick @<<
+$fox
+jumped
+@*
+$multiline
+^<<<<<<<<< ~~
+$foo
+now @<<the@>>>> for all@|||||men to come @<<<<
+'i' . 's', "time\n", $good, 'to'
+.
+EOFORMAT
+
+open(OUT2, '>Op.write.tmp') || die "Can't create Op.write.tmp";
+
+$fox = 'foxiness';
+$good = 'good';
+$multiline = "forescore\nand\nseven years\n";
+$foo = 'when in the course of human events it becomes necessary';
+write(OUT2);
+close OUT2;
+
+$right =
+"the brown quick fox
+jumped
+forescore
+and
+seven years
+when in
+the course
+of human
+events it
+becomes
+necessary
+now is the time for all good men to come to\n";
+
+if (`cat Op.write.tmp` eq $right)
+    { print "ok 3\n"; unlink 'Op.write.tmp'; }
+else
+    { print "not ok 3\n"; }
+
diff --git a/toke.c b/toke.c
index 8cf0264d1d..40df16ab6d 100644
--- a/toke.c
+++ b/toke.c
@@ -1,4 +1,4 @@
-/* $Header: toke.c,v 3.0.1.6 90/03/12 17:06:36 lwall Locked $
+/* $Header: toke.c,v 3.0.1.7 90/03/27 16:32:37 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	toke.c,v $
+ * Revision 3.0.1.7  90/03/27  16:32:37  lwall
+ * patch16: MSDOS support
+ * patch16: formats didn't work inside eval
+ * patch16: final semicolon in program wasn't optional with -p or -n
+ * 
  * Revision 3.0.1.6  90/03/12  17:06:36  lwall
  * patch13: last semicolon of program is now optional, just for Randal
  * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
@@ -197,6 +202,7 @@ yylex()
 	    }
 	}
 	if (in_format) {
+	    bufptr = bufend;
 	    yylval.formval = load_format();
 	    in_format = FALSE;
 	    oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
@@ -211,8 +217,8 @@ yylex()
 		(void)fclose(rsfp);
 	    rsfp = Nullfp;
 	    if (minus_n || minus_p) {
-		str_set(linestr,minus_p ? "}continue{print;" : "");
-		str_cat(linestr,"}");
+		str_set(linestr,minus_p ? ";}continue{print" : "");
+		str_cat(linestr,";}");
 		oldoldbufptr = oldbufptr = s = str_get(linestr);
 		bufend = linestr->str_ptr + linestr->str_cur;
 		minus_n = minus_p = 0;
@@ -302,10 +308,16 @@ yylex()
 	    d = bufend;
 	    while (s < d && *s != '\n')
 		s++;
-	    if (s < d) {
+	    if (s < d)
 		s++;
-		line++;
+	    if (in_format) {
+		bufptr = s;
+		yylval.formval = load_format();
+		in_format = FALSE;
+		oldoldbufptr = oldbufptr = s = bufptr + 1;
+		TERM(FORMLIST);
 	    }
+	    line++;
 	}
 	else {
 	    *s = '\0';
@@ -556,6 +568,8 @@ yylex()
 	SNARFWORD;
 	if (strEQ(d,"bind"))
 	    FOP2(O_BIND);
+	if (strEQ(d,"binmode"))
+	    FOP(O_BINMODE);
 	break;
     case 'c': case 'C':
 	SNARFWORD;
@@ -2074,6 +2088,7 @@ load_format()
 {
     FCMD froot;
     FCMD *flinebeg;
+    char *eol;
     register FCMD *fprev = &froot;
     register FCMD *fcmd;
     register char *s;
@@ -2083,7 +2098,8 @@ load_format()
     bool repeater;
 
     Zero(&froot, 1, FCMD);
-    while ((s = str_gets(linestr,rsfp, 0)) != Nullch) {
+    s = bufptr;
+    while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) {
 	line++;
 	if (perldb) {
 	    STR *tmpstr = Str_new(89,0);
@@ -2091,21 +2107,29 @@ load_format()
 	    str_sset(tmpstr,linestr);
 	    astore(lineary,(int)line,tmpstr);
 	}
-	bufend = linestr->str_ptr + linestr->str_cur;
-	if (strEQ(s,".\n")) {
+	if (in_eval && !rsfp) {
+	    eol = index(s,'\n');
+	    if (!eol++)
+		eol = bufend;
+	}
+	else
+	    eol = bufend = linestr->str_ptr + linestr->str_cur;
+	if (strnEQ(s,".\n",2)) {
 	    bufptr = s;
 	    return froot.f_next;
 	}
-	if (*s == '#')
+	if (*s == '#') {
+	    s = eol;
 	    continue;
+	}
 	flinebeg = Nullfcmd;
 	noblank = FALSE;
 	repeater = FALSE;
-	while (s < bufend) {
+	while (s < eol) {
 	    Newz(804,fcmd,1,FCMD);
 	    fprev->f_next = fcmd;
 	    fprev = fcmd;
-	    for (t=s; t < bufend && *t != '@' && *t != '^'; t++) {
+	    for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
 		if (*t == '~') {
 		    noblank = TRUE;
 		    *t = ' ';
@@ -2118,7 +2142,7 @@ load_format()
 	    fcmd->f_pre = nsavestr(s, t-s);
 	    fcmd->f_presize = t-s;
 	    s = t;
-	    if (s >= bufend) {
+	    if (s >= eol) {
 		if (noblank)
 		    fcmd->f_flags |= FC_NOBLANK;
 		if (repeater)
@@ -2162,7 +2186,7 @@ load_format()
 	}
 	if (flinebeg) {
 	  again:
-	    if ((s = str_gets(linestr, rsfp, 0)) == Nullch)
+	    if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch)
 		goto badform;
 	    line++;
 	    if (perldb) {
@@ -2171,55 +2195,67 @@ load_format()
 		str_sset(tmpstr,linestr);
 		astore(lineary,(int)line,tmpstr);
 	    }
-	    if (strEQ(s,".\n")) {
+	    if (in_eval && !rsfp) {
+		eol = index(s,'\n');
+		if (!eol++)
+		    eol = bufend;
+	    }
+	    else
+		eol = bufend = linestr->str_ptr + linestr->str_cur;
+	    if (strnEQ(s,".\n",2)) {
 		bufptr = s;
 		yyerror("Missing values line");
 		return froot.f_next;
 	    }
-	    if (*s == '#')
+	    if (*s == '#') {
+		s = eol;
 		goto again;
-	    bufend = linestr->str_ptr + linestr->str_cur;
-	    str = flinebeg->f_unparsed = Str_new(91,bufend - bufptr);
+	    }
+	    str = flinebeg->f_unparsed = Str_new(91,eol - s);
 	    str->str_u.str_hash = curstash;
 	    str_nset(str,"(",1);
 	    flinebeg->f_line = line;
-	    if (!flinebeg->f_next->f_type || index(linestr->str_ptr, ',')) {
-		str_scat(str,linestr);
+	    eol[-1] = '\0';
+	    if (!flinebeg->f_next->f_type || index(s, ',')) {
+		eol[-1] = '\n';
+		str_ncat(str, s, eol - s - 1);
 		str_ncat(str,",$$);",5);
+		s = eol;
 	    }
 	    else {
-		while (s < bufend && isspace(*s))
+		eol[-1] = '\n';
+		while (s < eol && isspace(*s))
 		    s++;
 		t = s;
-		while (s < bufend) {
+		while (s < eol) {
 		    switch (*s) {
 		    case ' ': case '\t': case '\n': case ';':
 			str_ncat(str, t, s - t);
 			str_ncat(str, "," ,1);
-			while (s < bufend && (isspace(*s) || *s == ';'))
+			while (s < eol && (isspace(*s) || *s == ';'))
 			    s++;
 			t = s;
 			break;
 		    case '$':
 			str_ncat(str, t, s - t);
 			t = s;
-			s = scanreg(s,bufend,tokenbuf);
+			s = scanreg(s,eol,tokenbuf);
 			str_ncat(str, t, s - t);
 			t = s;
-			if (s < bufend && *s && index("$'\"",*s))
+			if (s < eol && *s && index("$'\"",*s))
 			    str_ncat(str, ",", 1);
 			break;
 		    case '"': case '\'':
 			str_ncat(str, t, s - t);
 			t = s;
 			s++;
-			while (s < bufend && (*s != *t || s[-1] == '\\'))
+			while (s < eol && (*s != *t || s[-1] == '\\'))
 			    s++;
-			if (s < bufend)
+			if (s < eol)
 			    s++;
 			str_ncat(str, t, s - t);
 			t = s;
-			if (s < bufend && *s && index("$'\"",*s))
+			if (s < eol && *s && index("$'\"",*s))
 			    str_ncat(str, ",", 1);
 			break;
 		    default:
diff --git a/util.c b/util.c
index 96f142aad2..07e057b907 100644
--- a/util.c
+++ b/util.c
@@ -1,4 +1,4 @@
-/* $Header: util.c,v 3.0.1.4 90/03/01 10:26:48 lwall Locked $
+/* $Header: util.c,v 3.0.1.5 90/03/27 16:35:13 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	util.c,v $
+ * Revision 3.0.1.5  90/03/27  16:35:13  lwall
+ * patch16: MSDOS support
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * patch16: tail anchored pattern could dump if string to search was shorter
+ * 
  * Revision 3.0.1.4  90/03/01  10:26:48  lwall
  * patch9: fbminstr() called instr() rather than ninstr()
  * patch9: nested evals clobbered their longjmp environment
@@ -492,6 +497,8 @@ STR *littlestr;
     littlelen = littlestr->str_cur;
 #ifndef lint
     if (littlestr->str_pok & SP_TAIL && !multiline) {	/* tail anchored? */
+	if (littlelen > bigend - big)
+	    return Nullch;
 	little = (unsigned char*)littlestr->str_ptr;
 	if (littlestr->str_pok & SP_CASEFOLD) {	/* oops, fake it */
 	    big = bigend - littlelen;		/* just start near end */
@@ -1116,6 +1123,7 @@ register long l;
 #endif /* BYTEORDER != 0x4321 */
 #endif /* HTONS */
 
+#ifndef MSDOS
 FILE *
 mypopen(cmd,mode)
 char	*cmd;
@@ -1175,6 +1183,7 @@ char	*mode;
     forkprocess = pid;
     return fdopen(p[this], mode);
 }
+#endif /* !MSDOS */
 
 #ifdef NOTDEF
 dumpfds(s)
@@ -1209,6 +1218,7 @@ int newfd;
 }
 #endif
 
+#ifndef MSDOS
 int
 mypclose(ptr)
 FILE *ptr;
@@ -1250,6 +1260,7 @@ FILE *ptr;
     str_numset(str,0.0);
     return(status);
 }
+#endif /* !MSDOS */
 
 pidgone(pid,status)
 int pid;
@@ -1311,3 +1322,17 @@ register int count;
 	from = frombase;
     }
 }
+
+#ifndef CASTNEGFLOAT
+unsigned long
+castulong(f)
+double f;
+{
+    long along;
+
+    if (f >= 0.0)
+	return (unsigned long)f;
+    along = (long)f;
+    return (unsigned long)along;
+}
+#endif