perl 3.0 patch #17 patch #16, continued

See patch #16.

6 files changed, 561 insertions, 0 deletions

diff --git a/msdos/dir.h b/msdos/dir.h
new file mode 100644
index 0000000000..abda0c25b2
--- /dev/null
+++ b/msdos/dir.h
@@ -0,0 +1,55 @@
+/* $Header: dir.h,v 3.0.1.1 90/03/27 16:07:08 lwall Locked $
+ *
+ *    (C) Copyright 1987, 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:	dir.h,v $
+ * Revision 3.0.1.1  90/03/27  16:07:08  lwall
+ * patch16: MSDOS support
+ * 
+ * Revision 1.1  90/03/18  20:32:29  dds
+ * Initial revision
+ *
+ *
+ */
+
+/*
+ * defines the type returned by the directory(3) functions
+ */
+
+#ifndef __DIR_INCLUDED
+#define __DIR_INCLUDED
+
+/*Directory entry size */
+#ifdef DIRSIZ
+#undef DIRSIZ
+#endif
+#define DIRSIZ(rp)	(sizeof(struct direct))
+
+/*
+ * Structure of a directory entry
+ */
+struct direct	{
+	ino_t	d_ino;			/* inode number (not used by MS-DOS) */
+	int	d_namlen;		/* Name length */
+	char	d_name[13];		/* file name */
+};
+
+struct _dir_struc {			/* Structure used by dir operations */
+	char *start;			/* Starting position */
+	char *curr;			/* Current position */
+	struct direct dirstr;		/* Directory structure to return */
+};
+
+typedef struct _dir_struc DIR;		/* Type returned by dir operations */
+
+DIR *cdecl opendir(char *filename);
+struct direct *readdir(DIR *dirp);
+long telldir(DIR *dirp);
+void seekdir(DIR *dirp,long loc);
+void rewinddir(DIR *dirp);
+void closedir(DIR *dirp);
+
+#endif /* __DIR_INCLUDED */
diff --git a/msdos/directory.c b/msdos/directory.c
new file mode 100644
index 0000000000..b435453a17
--- /dev/null
+++ b/msdos/directory.c
@@ -0,0 +1,178 @@
+/* $Header: directory.c,v 3.0.1.1 90/03/27 16:07:37 lwall Locked $
+ *
+ *    (C) Copyright 1987, 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:	directory.c,v $
+ * Revision 3.0.1.1  90/03/27  16:07:37  lwall
+ * patch16: MSDOS support
+ * 
+ * Revision 1.3  90/03/16  22:39:40  dds
+ * Fixed malloc problem.
+ *
+ * Revision 1.2  88/07/23  00:08:39  dds
+ * Added inode non-zero filling.
+ *
+ * Revision 1.1  88/07/23  00:03:50  dds
+ * Initial revision
+ *
+ */
+
+/*
+ * UNIX compatible directory access functions
+ */
+
+#include <sys/types.h>
+#include <sys/dir.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#include <dos.h>
+#include <ctype.h>
+
+/*
+ * File names are converted to lowercase if the
+ * CONVERT_TO_LOWER_CASE variable is defined.
+ */
+#define CONVERT_TO_LOWER_CASE
+
+#define PATHLEN 65
+
+#ifndef lint
+static char     rcsid[] = "$Header: director.c;v 1.3 90/03/16 22:39:40 dds Exp
+ $";
+#endif
+
+DIR *
+opendir(char *filename)
+{
+	DIR            *p;
+	char           *oldresult, *result;
+	union REGS      srv;
+	struct SREGS    segregs;
+	register        reslen = 0;
+	char            scannamespc[PATHLEN];
+	char		*scanname = scannamespc;	/* To take address we need a pointer */
+
+	/*
+	 * Structure used by the MS-DOS directory system calls.
+	 */
+	struct dir_buff {
+		char            reserved[21];	/* Reserved for MS-DOS */
+		unsigned char   attribute;	/* Attribute */
+		unsigned int    time;		/* Time */
+		unsigned int    date;		/* Date */
+		long            size;		/* Size of file */
+		char            fn[13];		/* Filename */
+	} buffspc, *buff = &buffspc;
+
+
+	if (!(p = (DIR *) malloc(sizeof(DIR))))
+		return NULL;
+
+	/* Initialize result to use realloc on it */
+	if (!(result = malloc(1))) {
+		free(p);
+		return NULL;
+	}
+
+	/* Create the search pattern */
+	strcpy(scanname, filename);
+	if (strchr("/\\", *(scanname + strlen(scanname) - 1)) == NULL)
+		strcat(scanname, "/*.*");
+	else
+		strcat(scanname, "*.*");
+
+	segread(&segregs);
+#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
+	segregs.ds = FP_SEG(buff);
+	srv.x.dx = FP_OFF(buff);
+#else
+	srv.x.dx = (unsigned int) buff;
+#endif
+	srv.h.ah = 0x1a;	/* Set DTA to DS:DX */
+	intdosx(&srv, &srv, &segregs);
+
+#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
+	segregs.ds = FP_SEG(scanname);
+	srv.x.dx = FP_OFF(scanname);
+#else
+	srv.x.dx = (unsigned int) scanname;
+#endif
+	srv.x.cx = 0xff;	/* Search mode */
+
+	for (srv.h.ah = 0x4e; !intdosx(&srv, &srv, &segregs); srv.h.ah = 0x4f) {
+		if ((result = (char *) realloc(result, reslen + strlen(buff->fn) + 1)) ==
+ NULL) {
+			free(p);
+			free(oldresult);
+			return NULL;
+		}
+		oldresult = result;
+#ifdef CONVERT_TO_LOWER_CASE
+		strcpy(result + reslen, strlwr(buff->fn));
+#else
+		strcpy(result + reslen, buff->fn);
+#endif
+		reslen += strlen(buff->fn) + 1;
+	}
+
+	if (!(result = realloc(result, reslen + 1))) {
+		free(p);
+		free(oldresult);
+		return NULL;
+	} else {
+		p->start = result;
+		p->curr = result;
+		*(result + reslen) = '\0';
+		return p;
+	}
+}
+
+
+struct direct  *
+readdir(DIR *dirp)
+{
+	char           *p;
+	register        len;
+	static          dummy;
+
+	p = dirp->curr;
+	len = strlen(p);
+	if (*p) {
+		dirp->curr += len + 1;
+		strcpy(dirp->dirstr.d_name, p);
+		dirp->dirstr.d_namlen = len;
+		/* To fool programs */
+		dirp->dirstr.d_ino = ++dummy;
+		return &(dirp->dirstr);
+	} else
+		return NULL;
+}
+
+long
+telldir(DIR *dirp)
+{
+	return (long) dirp->curr;	/* ouch! pointer to long cast */
+}
+
+void
+seekdir(DIR *dirp, long loc)
+{
+	dirp->curr = (char *) loc;	/* ouch! long to pointer cast */
+}
+
+void
+rewinddir(DIR *dirp)
+{
+	dirp->curr = dirp->start;
+}
+
+void
+closedir(DIR *dirp)
+{
+	free(dirp->start);
+	free(dirp);
+}
diff --git a/msdos/eg/crlf.bat b/msdos/eg/crlf.bat
new file mode 100644
index 0000000000..24d73661b9
--- /dev/null
+++ b/msdos/eg/crlf.bat
@@ -0,0 +1,32 @@
+@REM=("
+@perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+@end ") if 0 ;
+
+# Convert all the files in the current directory from unix to MS-DOS
+# line ending conventions.
+#
+# By Diomidis Spinellis
+#
+open(FILES, 'find . -print |');
+while ($file = <FILES>) {
+	$file =^ s/[\n\r]//;
+	if (-f $file) {
+		if (-B $file) {
+			print STDERR "Skipping binary file $file\n";
+			next;
+		}
+		($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime,
+ $blksize, $blocks) = stat($file);
+		open(IFILE, "$file");
+		open(OFILE, ">xl$$");
+		while (<IFILE>) {
+			print OFILE;
+		}
+		close(OFILE) || die "close xl$$: $!\n";
+		close(IFILE) || die "close $file: $!\n";
+		unlink($file) || die "unlink $file: $!\n";
+		rename("xl$$", $file) || die "rename(xl$$, $file): $!\n";
+		chmod($mode, $file) || die "chmod($mode, $file: $!\n";
+		utime($atime, $mtime, $file) || die "utime($atime, $mtime, $file): $!\n";
+	}
+}
diff --git a/msdos/eg/lf.bat b/msdos/eg/lf.bat
new file mode 100644
index 0000000000..9c13eef840
--- /dev/null
+++ b/msdos/eg/lf.bat
@@ -0,0 +1,33 @@
+@REM=("
+@perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+@end ") if 0 ;
+
+# Convert all the files in the current directory from MS-DOS to unix
+# line ending conventions.
+#
+# By Diomidis Spinellis
+#
+open(FILES, 'find . -print |');
+while ($file = <FILES>) {
+	$file =^ s/[\n\r]//;
+	if (-f $file) {
+		if (-B $file) {
+			print STDERR "Skipping binary file $file\n";
+			next;
+		}
+		($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime,
+ $blksize, $blocks) = stat($file);
+		open(IFILE, "$file");
+		open(OFILE, ">xl$$");
+		binmode OFILE || die "binmode xl$$: $!\n";
+		while (<IFILE>) {
+			print OFILE;
+		}
+		close(OFILE) || die "close xl$$: $!\n";
+		close(IFILE) || die "close $file: $!\n";
+		unlink($file) || die "unlink $file: $!\n";
+		rename("xl$$", $file) || die "rename(xl$$, $file): $!\n";
+		chmod($mode, $file) || die "chmod($mode, $file: $!\n";
+		utime($atime, $mtime, $file) || die "utime($atime, $mtime, $file): $!\n";
+	}
+}
diff --git a/msdos/glob.c b/msdos/glob.c
new file mode 100644
index 0000000000..19fb2ab7ba
--- /dev/null
+++ b/msdos/glob.c
@@ -0,0 +1,17 @@
+/*
+ * Globbing for MS-DOS.  Relies on the expansion done by the library
+ * startup code. (dds)
+ */
+
+#include <stdio.h>
+#include <string.h>
+
+main(int argc, char *argv[])
+{
+	register i;
+
+	for (i = 1; i < argc; i++) {
+		fputs(strlwr(argv[i]), stdout);
+		putchar(0);
+	}
+}
diff --git a/msdos/msdos.c b/msdos/msdos.c
new file mode 100644
index 0000000000..7deb0aa71e
--- /dev/null
+++ b/msdos/msdos.c
@@ -0,0 +1,246 @@
+/* $Header: msdos.c,v 3.0.1.1 90/03/27 16:10:41 lwall Locked $
+ *
+ *    (C) Copyright 1989, 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:	msdos.c,v $
+ * Revision 3.0.1.1  90/03/27  16:10:41  lwall
+ * patch16: MSDOS support
+ * 
+ * Revision 1.1  90/03/18  20:32:01  dds
+ * Initial revision
+ *
+ */
+
+/*
+ * Various Unix compatibility functions for MS-DOS.
+ */
+
+#include <stdio.h>
+#include <errno.h>
+#include <dos.h>
+#include <time.h>
+#include <process.h>
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/*
+ * Interface to the MS-DOS ioctl system call.
+ * The function 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
+ *
+ * Notice that this restricts the ioctl subcodes stored in AL to 00-0f
+ * In the Ralf Borwn interrupt list 90.1 there are no subcodes above AL=0f
+ * so we are ok.
+ * Furthermore CH is also restriced in the same area.  Where CH is used as a
+ * code it always is between 00-0f.  In the case where it forms a count
+ * together with CL we arbitrarily set the highest count limit to 4095.  It
+ * sounds reasonable for an ioctl.
+ * The other alternative would have been to use the pointer argument to
+ * point the the values of CX.  The problem with this approach is that
+ * of accessing wild regions when DX is used as a number and not as a
+ * pointer.
+ */
+int
+ioctl(int handle, unsigned int function, char *data)
+{
+	union REGS      srv;
+	struct SREGS    segregs;
+
+	srv.h.ah = 0x44;
+	srv.h.al = function & 0xf;
+	srv.x.bx = handle;
+	srv.x.cx = function >> 4;
+	segread(&segregs);
+#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
+	segregs.ds = FP_SEG(data);
+	srv.x.dx = FP_OFF(data);
+#else
+	srv.x.dx = (unsigned int) data;
+#endif
+	intdosx(&srv, &srv, &segregs);
+	if (srv.x.cflag & 1) {
+		switch(srv.x.ax ){
+		case 1:
+			errno = EINVAL;
+			break;
+		case 2:
+		case 3:
+			errno = ENOENT;
+			break;
+		case 4:
+			errno = EMFILE;
+			break;
+		case 5:
+			errno = EPERM;
+			break;
+		case 6:
+			errno = EBADF;
+			break;
+		case 8:
+			errno = ENOMEM;
+			break;
+		case 0xc:
+		case 0xd:
+		case 0xf:
+			errno = EINVAL;
+			break;
+		case 0x11:
+			errno = EXDEV;
+			break;
+		case 0x12:
+			errno = ENFILE;
+			break;
+		default:
+			errno = EZERO;
+			break;
+		}
+		return -1;
+	} else {
+		switch (function & 0xf) {
+		case 0: case 9: case 0xa:
+			return srv.x.dx;
+		case 2: case 3: case 4: case 5:
+		case 6: case 7: case 8: case 0xe:
+			return srv.x.ax;
+		case 1: case 0xb: case 0xc: case 0xd:
+		case 0xf:
+		default:
+			return 0;
+		}
+	}
+}
+
+
+/*
+ * Sleep function.
+ */
+void
+sleep(unsigned len)
+{
+	time_t end;
+
+	end = time((time_t *)0) + len;
+	while (time((time_t *)0) < end)
+		;
+}
+
+/*
+ * Just pretend that everyone is a superuser
+ */
+int
+getuid(void)
+{
+	return 0;
+}
+
+int
+geteuid(void)
+{
+	return 0;
+}
+
+int
+getgid(void)
+{
+	return 0;
+}
+
+int
+getegid(void)
+{
+	return 0;
+}
+
+/*
+ * The following code is based on the do_exec and do_aexec functions
+ * in file doio.c
+ */
+int
+do_aspawn(really,arglast)
+STR *really;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register char **a;
+    char **argv;
+    char *tmps;
+    int status;
+
+    if (items) {
+	New(1101,argv, items+1, char*);
+	a = argv;
+	for (st += ++sp; items > 0; items--,st++) {
+	    if (*st)
+		*a++ = str_get(*st);
+	    else
+		*a++ = "";
+	}
+	*a = Nullch;
+	if (really && *(tmps = str_get(really)))
+	    status = spawnvp(P_WAIT,tmps,argv);
+	else
+	    status = spawnvp(P_WAIT,argv[0],argv);
+	Safefree(argv);
+    }
+    return status;
+}
+
+char *getenv(char *name);
+
+int
+do_spawn(cmd)
+char *cmd;
+{
+    register char **a;
+    register char *s;
+    char **argv;
+    char flags[10];
+    int status;
+    char *shell, *cmd2;
+
+    /* save an extra exec if possible */
+    if ((shell = getenv("COMSPEC")) == 0)
+	shell = "\\command.com";
+
+    /* see if there are shell metacharacters in it */
+    if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|'))
+	  doshell:
+	    return spawnl(P_WAIT,shell,shell,"/c",cmd,(char*)0);
+
+    New(1102,argv, strlen(cmd) / 2 + 2, char*);
+
+    New(1103,cmd2, strlen(cmd) + 1, char);
+    strcpy(cmd2, cmd);
+    a = argv;
+    for (s = cmd2; *s;) {
+	while (*s && isspace(*s)) s++;
+	if (*s)
+	    *(a++) = s;
+	while (*s && !isspace(*s)) s++;
+	if (*s)
+	    *s++ = '\0';
+    }
+    *a = Nullch;
+    if (argv[0])
+	if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) {
+	    Safefree(argv);
+	    Safefree(cmd2);
+	    goto doshell;
+	}
+    Safefree(cmd2);
+    Safefree(argv);
+    return status;
+}