perl 3.0 patch #18 patch #16, continued

See patch #16.

3 files changed, 316 insertions, 0 deletions

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;
+}