perl 4.0.00: (no release announcement available)perl-4.0.00

So far, 4.0 is still a beta test version.  For the last production
version, look in pub/perl.3.0/kits@44.

18 files changed, 1018 insertions, 103 deletions

diff --git a/os2/README.OS2 b/os2/README.OS2
index 11ff14c4d4..7e3536df82 100644
--- a/os2/README.OS2
+++ b/os2/README.OS2
@@ -325,6 +325,8 @@ director.c        directory routines
 os2.c             kernel of OS/2 port (see below)
 popen.c           new popen.c
 mktemp.c          enhanced mktemp(), uses TMP env. variable, used by popen.c
+alarm.c           PD implementation for alarm()
+alarm.h		  header for alarm.c
 
 perl.cs           Compiler Shell script for perl itself
 perl.def          linker definition file for perl
@@ -352,9 +354,10 @@ especially not with -DDEBUGGING
 
                                 Kai Uwe Rommel
                                 rommel@lan.informatik.tu-muenchen.dbp.de
-                                Breslauer Str. 25
-                                D-8756 Kahl/Main
-  
+                                Zennerstr. 1
+                                D-8000 Muenchen 70
+
+
 + I have verified with patchlevel 37, that the OS/2 port compiles,
   after doing two minor changes. HPFS filenames support was also added.
   Some bugs were fixed.
@@ -379,3 +382,25 @@ especially not with -DDEBUGGING
  				October 1990
 				Kai Uwe Rommel
 				rommel@lan.informatik.tu-muenchen.dbp.de
+
+
+Verified patchlevel 40.
+Some bugs were fixed. Added alarm() support (using PD implementation).
+
+
+ 				November 1990
+
+                                Kai Uwe Rommel
+                                rommel@lan.informatik.tu-muenchen.dbp.de
+
+
+Verified patchlevel 44.
+Only two #ifdefs added to eval.c. Stack size for A2P had to be corrected.
+PERLGLOB separated from DOS version because of HPFS support.
+
+[Note: instead of #ifdef'ing eval.c I fixed it in perl.h--lwall]
+
+				January 1991
+
+                                Kai Uwe Rommel
+                                  rommel@lan.informatik.tu-muenchen.dbp.de
diff --git a/os2/a2p.cs b/os2/a2p.cs
index c12e226efa..189ce9776d 100644
--- a/os2/a2p.cs
+++ b/os2/a2p.cs
@@ -5,4 +5,4 @@ setargv.obj
 ..\os2\a2p.def
 a2p.exe
 
--AL -LB -S0xA000
+-AL -LB -S0x9000
diff --git a/os2/alarm.c b/os2/alarm.c
new file mode 100644
index 0000000000..974e2380d8
--- /dev/null
+++ b/os2/alarm.c
@@ -0,0 +1,149 @@
+/*
+ * This software is Copyright 1989 by Jack Hudler.
+ *
+ * Permission is hereby granted to copy, reproduce, redistribute or otherwise
+ * use this software as long as: there is no monetary profit gained
+ * specifically from the use or reproduction or this software, it is not
+ * sold, rented, traded or otherwise marketed, and this copyright notice is
+ * included prominently in any copy made.
+ *
+ * The author make no claims as to the fitness or correctness of this software
+ * for any use whatsoever, and it is provided as is. Any use of this software
+ * is at the user's own risk.
+ *
+ */
+
+/****************************** Module Header ******************************\
+* Module Name: alarm.c
+* Created    : 11-08-89
+* Author     : Jack Hudler  [jack@csccat.lonestar.org]
+* Copyright  : 1988 Jack Hudler.
+* Function   : Unix like alarm signal simulator.
+\***************************************************************************/
+
+/* Tested using OS2 1.2 with Microsoft C 5.1 and 6.0. */
+
+#define INCL_DOSPROCESS
+#define INCL_DOSSIGNALS
+#define INCL_DOS
+#include <os2.h>
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <signal.h>
+
+#include "alarm.h"
+
+#define ALARM_STACK 4096    /* This maybe over kill, but the page size is 4K */
+
+static  PBYTE     pbAlarmStack;
+static  SEL       selAlarmStack;
+static  TID       tidAlarm;
+static  PID       pidMain;
+static  BOOL      bAlarmInit=FALSE;
+static  BOOL      bAlarmRunning=FALSE;
+static  USHORT    uTime;
+
+static VOID FAR alarm_thread ( VOID )
+{
+    while(1)
+    {
+      if (bAlarmRunning)
+      {
+        DosSleep(1000L);
+        uTime--;
+        if (uTime==0L)
+        {
+          // send signal to the main process.. I could have put raise() here
+          // however that would require the use of the multithreaded library,
+          // and it does not contain raise()!
+          // I tried it with the standard library, this signaled ok, but a
+          // test printf in the signal would not work and even caused SEGV.
+          // So I signal the process through OS/2 and then the process
+          // signals itself.
+          if (bAlarmRunning)
+            DosFlagProcess(pidMain,FLGP_PID, PFLG_A,1);
+          bAlarmRunning=FALSE;
+        }
+      }
+      else
+        DosSleep(500L);
+    }
+}
+
+static VOID PASCAL FAR AlarmSignal(USHORT usSigArg,USHORT usSigNum)
+{
+    /*
+     * this is not executed from the thread. The thread triggers Process
+     * flag A which is in the main processes scope, this inturn triggers
+     * (via the raise) SIGUSR1 which is defined to SIGALRM.
+     */
+    raise(SIGUSR1);
+}
+
+static void alarm_init(void)
+{
+    PFNSIGHANDLER pfnPrev;
+    USHORT       pfAction;
+    PIDINFO      pid;
+
+    bAlarmInit = TRUE;
+
+    if (!DosAllocSeg( ALARM_STACK, (PSEL) &selAlarmStack, SEG_NONSHARED ))
+    {
+      OFFSETOF(pbAlarmStack) = ALARM_STACK - 2;
+      SELECTOROF(pbAlarmStack) = selAlarmStack;
+      /* Create the thread */
+      if (DosCreateThread( alarm_thread, &tidAlarm, pbAlarmStack ))
+      {
+        fprintf(stderr,"Alarm thread failed to start.\n");
+        exit(1);
+      }
+      /* Setup the signal handler for Process Flag A */
+      if (DosSetSigHandler(AlarmSignal,&pfnPrev,&pfAction,SIGA_ACCEPT,SIG_PFLG_A))
+      {
+        fprintf(stderr,"SigHandler Failed to install.\n");
+        exit(1);
+      }
+      /* Save main process ID, we'll need it for triggering the signal */
+      DosGetPID(&pid);
+      pidMain = pid.pid;
+    }
+    else
+      exit(1);
+}
+
+unsigned alarm(unsigned sec)
+{
+    if (!bAlarmInit) alarm_init();
+
+    if (sec)
+    {
+      uTime = sec;
+      bAlarmRunning = TRUE;
+    }
+    else
+      bAlarmRunning = FALSE;
+
+    return 0;
+}
+
+#ifdef TESTING
+/* A simple test to see if it works */
+BOOL  x;
+
+void timeout(void)
+{
+    fprintf(stderr,"ALARM TRIGGERED!!\n");
+    DosBeep(1000,500);
+    x++;
+}
+
+void main(void)
+{
+    (void) signal(SIGALRM, timeout);
+    (void) alarm(1L);
+    printf("ALARM RUNNING!!\n");
+    while(!x);
+}
+#endif
diff --git a/os2/alarm.h b/os2/alarm.h
new file mode 100644
index 0000000000..b5fe69445b
--- /dev/null
+++ b/os2/alarm.h
@@ -0,0 +1,2 @@
+#define SIGALRM SIGUSR1
+unsigned alarm(unsigned);
diff --git a/os2/config.h b/os2/config.h
index e587a5cb74..6a707acb66 100644
--- a/os2/config.h
+++ b/os2/config.h
@@ -12,8 +12,8 @@
 #ifdef OS2
 #define PIPE
 #define GETPPID
-#define GETPRIORITY
-#define SETPRIORITY
+#define HAS_GETPRIORITY
+#define HAS_SETPRIORITY
 #define KILL
 #endif /* OS2 */
 
@@ -68,18 +68,18 @@
 #define CPPSTDIN "cc -{"
 #define CPPMINUS ""
 
-/* BCMP:
+/* HAS_BCMP:
  *	This symbol, if defined, indicates that the bcmp routine is available
  *	to compare blocks of memory.  If undefined, use memcmp.  If that's
  *	not available, roll your own.
  */
-/*#define	BCMP		/**/
+/*#define	HAS_BCMP		/**/
 
-/* BCOPY:
+/* HAS_BCOPY:
  *	This symbol, if defined, indicates that the bcopy routine is available
  *	to copy blocks of memory.  Otherwise you should probably use memcpy().
  */
-/*#define	BCOPY		/**/
+/*#define	HAS_BCOPY		/**/
 
 /* CHARSPRINTF:
  *	This symbol is defined if this system declares "char *sprintf()" in
@@ -89,12 +89,12 @@
  */
 /*#define	CHARSPRINTF 	/**/
 
-/* CRYPT:
+/* HAS_CRYPT:
  *	This symbol, if defined, indicates that the crypt routine is available
  *	to encrypt passwords and the like.
  */
 /* TODO */
-/*#define	CRYPT		/**/
+/*#define	HAS_CRYPT		/**/
 
 /* DOSUID:
  *	This symbol, if defined, indicates that the C program should
@@ -111,81 +111,81 @@
  */
 /*#define DOSUID		/**/
 
-/* DUP2:
+/* HAS_DUP2:
  *	This symbol, if defined, indicates that the dup2 routine is available
  *	to dup file descriptors.  Otherwise you should use dup().
  */
-#define	DUP2		/**/
+#define	HAS_DUP2		/**/
 
-/* FCHMOD:
+/* HAS_FCHMOD:
  *	This symbol, if defined, indicates that the fchmod routine is available
  *	to change mode of opened files.  If unavailable, use chmod().
  */
-/*#define	FCHMOD		/**/
+/*#define	HAS_FCHMOD		/**/
 
-/* FCHOWN:
+/* HAS_FCHOWN:
  *	This symbol, if defined, indicates that the fchown routine is available
  *	to change ownership of opened files.  If unavailable, use chown().
  */
-/*#define	FCHOWN		/**/
+/*#define	HAS_FCHOWN		/**/
 
-/* FCNTL:
+/* I_FCNTL:
  *	This symbol, if defined, indicates to the C program that it should
  *	include fcntl.h.
  */
-/*#define	FCNTL		/**/
+/*#define	I_FCNTL		/**/
 
-/* FLOCK:
+/* HAS_FLOCK:
  *	This symbol, if defined, indicates that the flock() routine is
  *	available to do file locking.
  */
-/*#define	FLOCK		/**/
+/*#define	HAS_FLOCK		/**/
 
-/* GETGROUPS:
+/* HAS_GETGROUPS:
  *	This symbol, if defined, indicates that the getgroups() routine is
  *	available to get the list of process groups.  If unavailable, multiple
  *	groups are probably not supported.
  */
-/*#define	GETGROUPS		/**/
+/*#define	HAS_GETGROUPS		/**/
 
-/* GETHOSTENT:
+/* HAS_GETHOSTENT:
  *	This symbol, if defined, indicates that the gethostent() routine is
  *	available to lookup host names in some data base or other.
  */
-/*#define	GETHOSTENT		/**/
+/*#define	HAS_GETHOSTENT		/**/
 
-/* GETPGRP:
+/* HAS_GETPGRP:
  *	This symbol, if defined, indicates that the getpgrp() routine is
  *	available to get the current process group.
  */
-/*#define	GETPGRP		/**/
+/*#define	HAS_GETPGRP		/**/
 
-/* GETPRIORITY:
+/* HAS_GETPRIORITY:
  *	This symbol, if defined, indicates that the getpriority() routine is
  *	available to get a process's priority.
  */
-/*#define	GETPRIORITY		/**/
+/*#define	HAS_GETPRIORITY		/**/
 
-/* HTONS:
+/* HAS_HTONS:
  *	This symbol, if defined, indicates that the htons routine (and friends)
  *	are available to do network order byte swapping.
  */
-/* HTONL:
+/* HAS_HTONL:
  *	This symbol, if defined, indicates that the htonl routine (and friends)
  *	are available to do network order byte swapping.
  */
-/* NTOHS:
+/* HAS_NTOHS:
  *	This symbol, if defined, indicates that the ntohs routine (and friends)
  *	are available to do network order byte swapping.
  */
-/* NTOHL:
+/* HAS_NTOHL:
  *	This symbol, if defined, indicates that the ntohl routine (and friends)
  *	are available to do network order byte swapping.
  */
-/*#define	HTONS		/**/
-/*#define	HTONL		/**/
-/*#define	NTOHS		/**/
-/*#define	NTOHL		/**/
+/*#define	HAS_HTONS		/**/
+/*#define	HAS_HTONL		/**/
+/*#define	HAS_NTOHS		/**/
+/*#define	HAS_NTOHL		/**/
 
 /* index:
  *	This preprocessor symbol is defined, along with rindex, if the system
@@ -198,124 +198,124 @@
 #define	index strchr	/* cultural */
 #define	rindex strrchr	/*  differences? */
 
-/* IOCTL:
+/* I_SYSIOCTL:
  *	This symbol, if defined, indicates that sys/ioctl.h exists and should
  *	be included.
  */
-/*#define	IOCTL		/**/
+/*#define	I_SYSIOCTL		/**/
 
-/* KILLPG:
+/* HAS_KILLPG:
  *	This symbol, if defined, indicates that the killpg routine is available
  *	to kill process groups.  If unavailable, you probably should use kill
  *	with a negative process number.
  */
-/*#define	KILLPG		/**/
+/*#define	HAS_KILLPG		/**/
 
-/* MEMCMP:
+/* HAS_MEMCMP:
  *	This symbol, if defined, indicates that the memcmp routine is available
  *	to compare blocks of memory.  If undefined, roll your own.
  */
-#define	MEMCMP		/**/
+#define	HAS_MEMCMP		/**/
 
-/* MEMCPY:
+/* HAS_MEMCPY:
  *	This symbol, if defined, indicates that the memcpy routine is available
  *	to copy blocks of memory.  Otherwise you should probably use bcopy().
  *	If neither is defined, roll your own.
  */
-#define	MEMCPY		/**/
+#define	HAS_MEMCPY		/**/
 
-/* MKDIR:
+/* HAS_MKDIR:
  *	This symbol, if defined, indicates that the mkdir routine is available
  *	to create directories.  Otherwise you should fork off a new process to
  *	exec /bin/mkdir.
  */
-#define	MKDIR		/**/
+#define	HAS_MKDIR		/**/
 
-/* NDBM:
+/* HAS_NDBM:
  *	This symbol, if defined, indicates that ndbm.h exists and should
  *	be included.
  */
-/*#define	NDBM		/**/
+#define	HAS_NDBM		/**/
 
-/* ODBM:
+/* HAS_ODBM:
  *	This symbol, if defined, indicates that dbm.h exists and should
  *	be included.
  */
-/*#define	ODBM		/**/
+/*#define	HAS_ODBM		/**/
 
-/* READDIR:
+/* HAS_READDIR:
  *	This symbol, if defined, indicates that the readdir routine is available
  *	from the C library to create directories.
  */
-#define	READDIR		/**/
+#define	HAS_READDIR		/**/
 
-/* RENAME:
+/* HAS_RENAME:
  *	This symbol, if defined, indicates that the rename routine is available
  *	to rename files.  Otherwise you should do the unlink(), link(), unlink()
  *	trick.
  */
-#define	RENAME		/**/
+#define	HAS_RENAME		/**/
 
-/* RMDIR:
+/* HAS_RMDIR:
  *	This symbol, if defined, indicates that the rmdir routine is available
  *	to remove directories.  Otherwise you should fork off a new process to
  *	exec /bin/rmdir.
  */
-#define	RMDIR		/**/
+#define	HAS_RMDIR		/**/
 
-/* SETEGID:
+/* HAS_SETEGID:
  *	This symbol, if defined, indicates that the setegid routine is available
  *	to change the effective gid of the current program.
  */
-/*#define	SETEGID		/**/
+/*#define	HAS_SETEGID		/**/
 
-/* SETEUID:
+/* HAS_SETEUID:
  *	This symbol, if defined, indicates that the seteuid routine is available
  *	to change the effective uid of the current program.
  */
-/*#define	SETEUID		/**/
+/*#define	HAS_SETEUID		/**/
 
-/* SETPGRP:
+/* HAS_SETPGRP:
  *	This symbol, if defined, indicates that the setpgrp() routine is
  *	available to set the current process group.
  */
-/*#define	SETPGRP		/**/
+/*#define	HAS_SETPGRP		/**/
 
-/* SETPRIORITY:
+/* HAS_SETPRIORITY:
  *	This symbol, if defined, indicates that the setpriority() routine is
  *	available to set a process's priority.
  */
-/*#define	SETPRIORITY		/**/
+/*#define	HAS_SETPRIORITY		/**/
 
-/* SETREGID:
+/* HAS_SETREGID:
  *	This symbol, if defined, indicates that the setregid routine is available
  *	to change the real and effective gid of the current program.
  */
-/*#define	SETREGID		/**/
+/*#define	HAS_SETREGID		/**/
 
-/* SETREUID:
+/* HAS_SETREUID:
  *	This symbol, if defined, indicates that the setreuid routine is available
  *	to change the real and effective uid of the current program.
  */
-/*#define	SETREUID		/**/
+/*#define	HAS_SETREUID		/**/
 
-/* SETRGID:
+/* HAS_SETRGID:
  *	This symbol, if defined, indicates that the setrgid routine is available
  *	to change the real gid of the current program.
  */
-/*#define	SETRGID		/**/
+/*#define	HAS_SETRGID		/**/
 
-/* SETRUID:
+/* HAS_SETRUID:
  *	This symbol, if defined, indicates that the setruid routine is available
  *	to change the real uid of the current program.
  */
-/*#define	SETRUID		/**/
+/*#define	HAS_SETRUID		/**/
 
-/* SOCKET:
+/* HAS_SOCKET:
  *      This symbol, if defined, indicates that the BSD socket interface is
  *      supported.
  */
-/* SOCKETPAIR:
+/* HAS_SOCKETPAIR:
  *      This symbol, if defined, indicates that the BSD socketpair call is
  *      supported.
  */
@@ -323,9 +323,9 @@
  *      This symbol, if defined, indicates that the 4.1c BSD socket interface
  *      is supported instead of the 4.2/4.3 BSD socket interface.
  */
-/*#undef SOCKET          /**/
+/*#undef HAS_SOCKET          /**/
 
-/*#undef SOCKETPAIR      /**/
+/*#undef HAS_SOCKETPAIR      /**/
 
 /*#undef        OLDSOCKET       /**/
 
@@ -348,33 +348,33 @@
  */
 #define	STRUCTCOPY	/**/
 
-/* SYMLINK:
+/* HAS_SYMLINK:
  *	This symbol, if defined, indicates that the symlink routine is available
  *	to create symbolic links.
  */
-/*#define	SYMLINK		/**/
+/*#define	HAS_SYMLINK		/**/
 
-/* SYSCALL:
+/* HAS_SYSCALL:
  *	This symbol, if defined, indicates that the syscall routine is available
  *	to call arbitrary system calls.  If undefined, that's tough.
  */
-/*#define	SYSCALL		/**/
+/*#define	HAS_SYSCALL		/**/
 
-/* TMINSYS:
+/* s_tm:
  *	This symbol is defined if this system declares "struct tm" in
  *	in <sys/time.h> rather than <time.h>.  We can't just say
  *	-I/usr/include/sys because some systems have both time files, and
  *	the -I trick gets the wrong one.
  */
-/* I_SYSTIME:
+/* I_SYS_TIME:
  *	This symbol is defined if this system has the file <sys/time.h>.
  */
 /*
  * I_TIME:
  *	This symbol is defined if time this  system has the file <time.h>.
  */
-/*#undef	TMINSYS 	/**/
-/*#define	I_SYSTIME 	/**/
+/*#undef	s_tm 	/**/
+/*#define	I_SYS_TIME 	/**/
 #define I_TIME
 
 /* VARARGS:
@@ -397,7 +397,7 @@
  */
 #define	VOIDSIG 	/**/
 
-/* VPRINTF:
+/* HAS_VPRINTF:
  *	This symbol, if defined, indicates that the vprintf routine is available
  *	to printf with a pointer to an argument list.  If unavailable, you
  *	may need to write your own, probably in terms of _doprnt().
@@ -408,7 +408,7 @@
  *	is up to the package author to declare vsprintf correctly based on the
  *	symbol.
  */
-#define	VPRINTF		/**/
+#define	HAS_VPRINTF		/**/
 /*#undef	CHARVSPRINTF 	/**/
 
 /* GIDTYPE:
@@ -458,11 +458,11 @@
 /*#define	PWQUOTA		/**/
 /*#undef	PWAGE		/**/
 
-/* I_SYSDIR:
+/* I_SYS_DIR:
  *	This symbol, if defined, indicates to the C program that it should
  *	include sys/dir.h.
  */
-#define	I_SYSDIR		/**/
+#define	I_SYS_DIR		/**/
 
 /* I_SYSIOCTL:
  *	This symbol, if defined, indicates that sys/ioctl.h exists and should
@@ -494,7 +494,7 @@
 #ifdef OS2
 #define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE",\
 	  /*      0      1     2     3      4      5     6     7    8 */\
-   "KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","CLD",\
+   "KILL","BUS","SEGV","SYS","PIPE","UALRM","TERM","ALRM","USR2","CLD",\
   /* 9     10     11    12    13     14     15     16     17    18 */\
    "PWR","USR3","BREAK","ABRT"
   /*19     20     21    22   */
diff --git a/os2/director.c b/os2/director.c
index d5accd73e1..3966d3d4bf 100644
--- a/os2/director.c
+++ b/os2/director.c
@@ -23,6 +23,7 @@
 #include <os2.h>
 
 
+#ifndef PERLGLOB
 int attributes = A_DIR | A_HIDDEN;
 
 
@@ -179,7 +180,9 @@ static void free_dircontents(struct _dircontents * dp)
 }
 
 
-static int IsFileSystemFAT(char *dir)
+static
+#endif
+int IsFileSystemFAT(char *dir)
 {
   USHORT nDrive;
   ULONG lMap;
@@ -216,7 +219,7 @@ static int IsFileSystemFAT(char *dir)
   }
 }
 
-
+#ifndef PERLGLOB
 static char *getdirent(char *dir)
 {
   int done;
@@ -244,3 +247,4 @@ static char *getdirent(char *dir)
     return NULL;
   }
 }
+#endif
diff --git a/os2/eg/alarm.pl b/os2/eg/alarm.pl
new file mode 100644
index 0000000000..8ceb4e2ba8
--- /dev/null
+++ b/os2/eg/alarm.pl
@@ -0,0 +1,16 @@
+sub handler {
+  local($sig) = @_;
+  print "Caught a SIG$sig -- shutting down\n";
+  exit(0);
+}
+
+$SIG{'INT'} = 'handler';
+$SIG{'QUIT'} = 'handler';
+$SIG{'ALRM'} = 'handler';
+
+print "Starting execution ...\n";
+alarm(10);
+
+while ( <> ) {
+}
+print "Normal exit.\n";
diff --git a/os2/eg/os2.pl b/os2/eg/os2.pl
index 224b9b386c..411d32712d 100644
--- a/os2/eg/os2.pl
+++ b/os2/eg/os2.pl
@@ -1,4 +1,5 @@
 extproc C:\binp\misc\perl.exe -S
+#!perl
 
 # os2.pl:  Demonstrates the OS/2 system calls and shows off some of the
 # features in common with the UNIX version.
diff --git a/os2/glob.c b/os2/glob.c
new file mode 100644
index 0000000000..b87251a46b
--- /dev/null
+++ b/os2/glob.c
@@ -0,0 +1,18 @@
+/*
+ * Globbing for OS/2.  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(IsFileSystemFAT(argv[i]) ? strlwr(argv[i]) : argv[i], stdout);
+    putchar(0);
+  }
+}
diff --git a/os2/os2.c b/os2/os2.c
index a1a464bf24..b8e240e9a7 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -1,4 +1,4 @@
-/* $Header: os2.c,v 3.0.1.2 90/11/10 01:42:38 lwall Locked $
+/* $Header: os2.c,v 4.0 91/03/20 01:36:21 lwall Locked $
  *
  *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	os2.c,v $
+ * Revision 4.0  91/03/20  01:36:21  lwall
+ * 4.0 baseline.
+ * 
  * Revision 3.0.1.2  90/11/10  01:42:38  lwall
  * patch38: more msdos/os2 upgrades
  * 
@@ -245,7 +248,7 @@ char *cmd;
 usage(char *myname)
 {
 #ifdef MSDOS
-  printf("\nUsage: %s [-acdnpsSvw] [-Dnumber] [-i[extension]] [-Idirectory]"
+  printf("\nUsage: %s [-acdnpsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]"
 #else
   printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]"
 #endif
@@ -267,7 +270,8 @@ usage(char *myname)
 #endif
   printf("\n  -v  print version number and patchlevel of perl"
          "\n  -w  turn warnings on for compilation of your script\n"
-         "\n  -Dnumber        set debugging flags"
+         "\n  -0[octal]       specify record separator (0, if no argument)"
+         "\n  -Dnumber        set debugging flags (argument is a bit mask)"
          "\n  -i[extension]   edit <> files in place (make backup if extension supplied)"
          "\n  -Idirectory     specify include directory in conjunction with -P"
          "\n  -e command      one line of script, multiple -e options are allowed"
diff --git a/os2/perl.bad b/os2/perl.bad
index 870785aa52..8dd016c513 100644
--- a/os2/perl.bad
+++ b/os2/perl.bad
@@ -5,3 +5,4 @@ DOSFLAGPROCESS
 DOSSETPRTY
 DOSGETPRTY
 DOSQFSATTACH
+DOSCREATETHREAD
diff --git a/os2/perl.cs b/os2/perl.cs
index 416e29c397..73bc4d7b8c 100644
--- a/os2/perl.cs
+++ b/os2/perl.cs
@@ -3,13 +3,16 @@ array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
 hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
 )
 (-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
-(-W1 -Od -Olt -I.
-os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c
+(-W1 -Od -Olt -I. -Ios2
+os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c os2\alarm.c
 )
 
+; link with this library if you have GNU gdbm for OS/2
+; remember to enable the NDBM symbol in config.h before compiling
+lgdbm.lib
 setargv.obj
 os2\perl.def
 os2\perl.bad
 perl.exe
 
--AL -LB -S0x8800
+-AL -LB -S0x8000
diff --git a/os2/perl.def b/os2/perl.def
index 2c990c26aa..c19e340a5b 100644
--- a/os2/perl.def
+++ b/os2/perl.def
@@ -1,2 +1,2 @@
 NAME PERL WINDOWCOMPAT NEWFILES
-DESCRIPTION 'PERL 3.0, patchlevel 37 - for MS-DOS and OS/2'
+DESCRIPTION 'PERL 3.0 - for MS-DOS and OS/2'
diff --git a/os2/perlglob.bad b/os2/perlglob.bad
new file mode 100644
index 0000000000..5f4efc8c18
--- /dev/null
+++ b/os2/perlglob.bad
@@ -0,0 +1 @@
+DOSQFSATTACH
diff --git a/os2/perlglob.cs b/os2/perlglob.cs
index 5f6758acfa..7f58c6058f 100644
--- a/os2/perlglob.cs
+++ b/os2/perlglob.cs
@@ -1,7 +1,9 @@
-msdos\glob.c
+os2\glob.c
+(-DPERLGLOB os2\director.c)
 
 setargv.obj
 os2\perlglob.def
+os2\perlglob.bad
 perlglob.exe
 
 -AS -LB -S0x1000
diff --git a/os2/s2p.cmd b/os2/s2p.cmd
new file mode 100644
index 0000000000..e7dac871ea
--- /dev/null
+++ b/os2/s2p.cmd
@@ -0,0 +1,676 @@
+extproc perl -Sx
+#!perl
+
+$bin = 'c:/bin';
+
+# $Header: s2p.cmd,v 4.0 91/03/20 01:37:09 lwall Locked $
+#
+# $Log:	s2p.cmd,v $
+# Revision 4.0  91/03/20  01:37:09  lwall
+# 4.0 baseline.
+# 
+# Revision 3.0.1.6  90/10/20  02:21:43  lwall
+# patch37: changed some ". config.sh" to ". ./config.sh"
+#
+# Revision 3.0.1.5  90/10/16  11:32:40  lwall
+# patch29: s2p modernized
+#
+# Revision 3.0.1.4  90/08/09  05:50:43  lwall
+# patch19: s2p didn't translate \n right
+#
+# Revision 3.0.1.3  90/03/01  10:31:21  lwall
+# patch9: s2p didn't handle \< and \>
+#
+# Revision 3.0.1.2  89/11/17  15:51:27  lwall
+# patch5: in s2p, line labels without a subsequent statement were done wrong
+# patch5: s2p left residue in /tmp
+#
+# Revision 3.0.1.1  89/11/11  05:08:25  lwall
+# patch2: in s2p, + within patterns needed backslashing
+# patch2: s2p was printing out some debugging info to the output file
+#
+# Revision 3.0  89/10/18  15:35:02  lwall
+# 3.0 baseline
+#
+# Revision 2.0.1.1  88/07/11  23:26:23  root
+# patch2: s2p didn't put a proper prologue on output script
+#
+# Revision 2.0  88/06/05  00:15:55  root
+# Baseline version 2.0.
+#
+#
+
+$indent = 4;
+$shiftwidth = 4;
+$l = '{'; $r = '}';
+
+while ($ARGV[0] =~ /^-/) {
+    $_ = shift;
+  last if /^--/;
+    if (/^-D/) {
+	$debug++;
+	open(BODY,'>-');
+	next;
+    }
+    if (/^-n/) {
+	$assumen++;
+	next;
+    }
+    if (/^-p/) {
+	$assumep++;
+	next;
+    }
+    die "I don't recognize this switch: $_\n";
+}
+
+unless ($debug) {
+    open(BODY,">sperl$$") ||
+      &Die("Can't open temp file: $!\n");
+}
+
+if (!$assumen && !$assumep) {
+    print BODY <<'EOT';
+while ($ARGV[0] =~ /^-/) {
+    $_ = shift;
+  last if /^--/;
+    if (/^-n/) {
+	$nflag++;
+	next;
+    }
+    die "I don't recognize this switch: $_\\n";
+}
+
+EOT
+}
+
+print BODY <<'EOT';
+
+#ifdef PRINTIT
+#ifdef ASSUMEP
+$printit++;
+#else
+$printit++ unless $nflag;
+#endif
+#endif
+LINE: while (<>) {
+EOT
+
+LINE: while (<>) {
+
+    # Wipe out surrounding whitespace.
+
+    s/[ \t]*(.*)\n$/$1/;
+
+    # Perhaps it's a label/comment.
+
+    if (/^:/) {
+	s/^:[ \t]*//;
+	$label = &make_label($_);
+	if ($. == 1) {
+	    $toplabel = $label;
+	}
+	$_ = "$label:";
+	if ($lastlinewaslabel++) {
+	    $indent += 4;
+	    print BODY &tab, ";\n";
+	    $indent -= 4;
+	}
+	if ($indent >= 2) {
+	    $indent -= 2;
+	    $indmod = 2;
+	}
+	next;
+    } else {
+	$lastlinewaslabel = '';
+    }
+
+    # Look for one or two address clauses
+
+    $addr1 = '';
+    $addr2 = '';
+    if (s/^([0-9]+)//) {
+	$addr1 = "$1";
+    }
+    elsif (s/^\$//) {
+	$addr1 = 'eof()';
+    }
+    elsif (s|^/||) {
+	$addr1 = &fetchpat('/');
+    }
+    if (s/^,//) {
+	if (s/^([0-9]+)//) {
+	    $addr2 = "$1";
+	} elsif (s/^\$//) {
+	    $addr2 = "eof()";
+	} elsif (s|^/||) {
+	    $addr2 = &fetchpat('/');
+	} else {
+	    &Die("Invalid second address at line $.\n");
+	}
+	$addr1 .= " .. $addr2";
+    }
+
+    # Now we check for metacommands {, }, and ! and worry
+    # about indentation.
+
+    s/^[ \t]+//;
+    # a { to keep vi happy
+    if ($_ eq '}') {
+	$indent -= 4;
+	next;
+    }
+    if (s/^!//) {
+	$if = 'unless';
+	$else = "$r else $l\n";
+    } else {
+	$if = 'if';
+	$else = '';
+    }
+    if (s/^{//) {	# a } to keep vi happy
+	$indmod = 4;
+	$redo = $_;
+	$_ = '';
+	$rmaybe = '';
+    } else {
+	$rmaybe = "\n$r";
+	if ($addr2 || $addr1) {
+	    $space = ' ' x $shiftwidth;
+	} else {
+	    $space = '';
+	}
+	$_ = &transmogrify();
+    }
+
+    # See if we can optimize to modifier form.
+
+    if ($addr1) {
+	if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
+	  $_ !~ / if / && $_ !~ / unless /) {
+	    s/;$/ $if $addr1;/;
+	    $_ = substr($_,$shiftwidth,1000);
+	} else {
+	    $_ = "$if ($addr1) $l\n$change$_$rmaybe";
+	}
+	$change = '';
+	next LINE;
+    }
+} continue {
+    @lines = split(/\n/,$_);
+    for (@lines) {
+	unless (s/^ *<<--//) {
+	    print BODY &tab;
+	}
+	print BODY $_, "\n";
+    }
+    $indent += $indmod;
+    $indmod = 0;
+    if ($redo) {
+	$_ = $redo;
+	$redo = '';
+	redo LINE;
+    }
+}
+if ($lastlinewaslabel++) {
+    $indent += 4;
+    print BODY &tab, ";\n";
+    $indent -= 4;
+}
+
+print BODY "}\n";
+if ($appendseen || $tseen || !$assumen) {
+    $printit++ if $dseen || (!$assumen && !$assumep);
+    print BODY <<'EOT';
+
+continue {
+#ifdef PRINTIT
+#ifdef DSEEN
+#ifdef ASSUMEP
+    print if $printit++;
+#else
+    if ($printit)
+	{ print; }
+    else
+	{ $printit++ unless $nflag; }
+#endif
+#else
+    print if $printit;
+#endif
+#else
+    print;
+#endif
+#ifdef TSEEN
+    $tflag = '';
+#endif
+#ifdef APPENDSEEN
+    if ($atext) { print $atext; $atext = ''; }
+#endif
+}
+EOT
+}
+
+close BODY;
+
+unless ($debug) {
+    open(HEAD,">sperl2$$.c")
+      || &Die("Can't open temp file 2: $!\n");
+    print HEAD "#define PRINTIT\n" if ($printit);
+    print HEAD "#define APPENDSEEN\n" if ($appendseen);
+    print HEAD "#define TSEEN\n" if ($tseen);
+    print HEAD "#define DSEEN\n" if ($dseen);
+    print HEAD "#define ASSUMEN\n" if ($assumen);
+    print HEAD "#define ASSUMEP\n" if ($assumep);
+    if ($opens) {print HEAD "$opens\n";}
+    open(BODY,"sperl$$")
+      || &Die("Can't reopen temp file: $!\n");
+    while (<BODY>) {
+	print HEAD $_;
+    }
+    close HEAD;
+
+    print <<"EOT";
+#!$bin/perl
+eval 'exec $bin/perl -S \$0 \$*'
+	if \$running_under_some_shell;
+
+EOT
+    open(BODY,"cc -E sperl2$$.c |") ||
+	&Die("Can't reopen temp file: $!\n");
+    while (<BODY>) {
+	/^# [0-9]/ && next;
+	/^[ \t]*$/ && next;
+	s/^<><>//;
+	print;
+    }
+}
+
+&Cleanup;
+exit;
+
+sub Cleanup {
+    unlink "sperl$$", "sperl2$$", "sperl2$$.c";
+}
+sub Die {
+    &Cleanup;
+    die $_[0];
+}
+sub tab {
+    "\t" x ($indent / 8) . ' ' x ($indent % 8);
+}
+sub make_filehandle {
+    local($_) = $_[0];
+    local($fname) = $_;
+    s/[^a-zA-Z]/_/g;
+    s/^_*//;
+    substr($_,0,1) =~ y/a-z/A-Z/ if /^[a-z]/;
+    if (!$seen{$_}) {
+	$opens .= <<"EOT";
+open($_,'>$fname') || die "Can't create $fname";
+EOT
+    }
+    $seen{$_} = $_;
+}
+
+sub make_label {
+    local($label) = @_;
+    $label =~ s/[^a-zA-Z0-9]/_/g;
+    if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
+    $label = substr($label,0,8);
+
+    # Could be a reserved word, so capitalize it.
+    substr($label,0,1) =~ y/a-z/A-Z/
+      if $label =~ /^[a-z]/;
+
+    $label;
+}
+
+sub transmogrify {
+    {	# case
+	if (/^d/) {
+	    $dseen++;
+	    chop($_ = <<'EOT');
+<<--#ifdef PRINTIT
+$printit = '';
+<<--#endif
+next LINE;
+EOT
+	    next;
+	}
+
+	if (/^n/) {
+	    chop($_ = <<'EOT');
+<<--#ifdef PRINTIT
+<<--#ifdef DSEEN
+<<--#ifdef ASSUMEP
+print if $printit++;
+<<--#else
+if ($printit)
+    { print; }
+else
+    { $printit++ unless $nflag; }
+<<--#endif
+<<--#else
+print if $printit;
+<<--#endif
+<<--#else
+print;
+<<--#endif
+<<--#ifdef APPENDSEEN
+if ($atext) {print $atext; $atext = '';}
+<<--#endif
+$_ = <>;
+<<--#ifdef TSEEN
+$tflag = '';
+<<--#endif
+EOT
+	    next;
+	}
+
+	if (/^a/) {
+	    $appendseen++;
+	    $command = $space . '$atext .=' . "\n<<--'";
+	    $lastline = 0;
+	    while (<>) {
+		s/^[ \t]*//;
+		s/^[\\]//;
+		unless (s|\\$||) { $lastline = 1;}
+		s/'/\\'/g;
+		s/^([ \t]*\n)/<><>$1/;
+		$command .= $_;
+		$command .= '<<--';
+		last if $lastline;
+	    }
+	    $_ = $command . "';";
+	    last;
+	}
+
+	if (/^[ic]/) {
+	    if (/^c/) { $change = 1; }
+	    $addr1 = '$iter = (' . $addr1 . ')';
+	    $command = $space . 'if ($iter == 1) { print'
+	      . "\n<<--'";
+	    $lastline = 0;
+	    while (<>) {
+		s/^[ \t]*//;
+		s/^[\\]//;
+		unless (s/\\$//) { $lastline = 1;}
+		s/'/\\'/g;
+		s/^([ \t]*\n)/<><>$1/;
+		$command .= $_;
+		$command .= '<<--';
+		last if $lastline;
+	    }
+	    $_ = $command . "';}";
+	    if ($change) {
+		$dseen++;
+		$change = "$_\n";
+		chop($_ = <<"EOT");
+<<--#ifdef PRINTIT
+$space\$printit = '';
+<<--#endif
+${space}next LINE;
+EOT
+	    }
+	    last;
+	}
+
+	if (/^s/) {
+	    $delim = substr($_,1,1);
+	    $len = length($_);
+	    $repl = $end = 0;
+	    $inbracket = 0;
+	    for ($i = 2; $i < $len; $i++) {
+		$c = substr($_,$i,1);
+		if ($c eq $delim) {
+		    if ($inbracket) {
+			substr($_, $i, 0) = '\\';
+			$i++;
+			$len++;
+		    }
+		    else {
+			if ($repl) {
+			    $end = $i;
+			    last;
+			} else {
+			    $repl = $i;
+			}
+		    }
+		}
+		elsif ($c eq '\\') {
+		    $i++;
+		    if ($i >= $len) {
+			$_ .= 'n';
+			$_ .= <>;
+			$len = length($_);
+			$_ = substr($_,0,--$len);
+		    }
+		    elsif (substr($_,$i,1) =~ /^[n]$/) {
+			;
+		    }
+		    elsif (!$repl &&
+		      substr($_,$i,1) =~ /^[(){}\w]$/) {
+			$i--;
+			$len--;
+			substr($_, $i, 1) = '';
+		    }
+		    elsif (!$repl &&
+		      substr($_,$i,1) =~ /^[<>]$/) {
+			substr($_,$i,1) = 'b';
+		    }
+		}
+		elsif ($c eq '[' && !$repl) {
+		    $i++ if substr($_,$i,1) eq '^';
+		    $i++ if substr($_,$i,1) eq ']';
+		    $inbracket = 1;
+		}
+		elsif ($c eq ']') {
+		    $inbracket = 0;
+		}
+		elsif (!$repl && index("()+",$c) >= 0) {
+		    substr($_, $i, 0) = '\\';
+		    $i++;
+		    $len++;
+		}
+	    }
+	    &Die("Malformed substitution at line $.\n")
+	      unless $end;
+	    $pat = substr($_, 0, $repl + 1);
+	    $repl = substr($_, $repl+1, $end-$repl-1);
+	    $end = substr($_, $end + 1, 1000);
+	    $dol = '$';
+	    $repl =~ s/\$/\\$/;
+	    $repl =~ s'&'$&'g;
+	    $repl =~ s/[\\]([0-9])/$dol$1/g;
+	    $subst = "$pat$repl$delim";
+	    $cmd = '';
+	    while ($end) {
+		if ($end =~ s/^g//) {
+		    $subst .= 'g';
+		    next;
+		}
+		if ($end =~ s/^p//) {
+		    $cmd .= ' && (print)';
+		    next;
+		}
+		if ($end =~ s/^w[ \t]*//) {
+		    $fh = &make_filehandle($end);
+		    $cmd .= " && (print $fh \$_)";
+		    $end = '';
+		    next;
+		}
+		&Die("Unrecognized substitution command".
+		  "($end) at line $.\n");
+	    }
+	    chop ($_ = <<"EOT");
+<<--#ifdef TSEEN
+$subst && \$tflag++$cmd;
+<<--#else
+$subst$cmd;
+<<--#endif
+EOT
+	    next;
+	}
+
+	if (/^p/) {
+	    $_ = 'print;';
+	    next;
+	}
+
+	if (/^w/) {
+	    s/^w[ \t]*//;
+	    $fh = &make_filehandle($_);
+	    $_ = "print $fh \$_;";
+	    next;
+	}
+
+	if (/^r/) {
+	    $appendseen++;
+	    s/^r[ \t]*//;
+	    $file = $_;
+	    $_ = "\$atext .= `cat $file 2>/dev/null`;";
+	    next;
+	}
+
+	if (/^P/) {
+	    $_ = 'print $1 if /(^.*\n)/;';
+	    next;
+	}
+
+	if (/^D/) {
+	    chop($_ = <<'EOT');
+s/^.*\n//;
+redo LINE if $_;
+next LINE;
+EOT
+	    next;
+	}
+
+	if (/^N/) {
+	    chop($_ = <<'EOT');
+$_ .= <>;
+<<--#ifdef TSEEN
+$tflag = '';
+<<--#endif
+EOT
+	    next;
+	}
+
+	if (/^h/) {
+	    $_ = '$hold = $_;';
+	    next;
+	}
+
+	if (/^H/) {
+	    $_ = '$hold .= $_ ? $_ : "\n";';
+	    next;
+	}
+
+	if (/^g/) {
+	    $_ = '$_ = $hold;';
+	    next;
+	}
+
+	if (/^G/) {
+	    $_ = '$_ .= $hold ? $hold : "\n";';
+	    next;
+	}
+
+	if (/^x/) {
+	    $_ = '($_, $hold) = ($hold, $_);';
+	    next;
+	}
+
+	if (/^b$/) {
+	    $_ = 'next LINE;';
+	    next;
+	}
+
+	if (/^b/) {
+	    s/^b[ \t]*//;
+	    $lab = &make_label($_);
+	    if ($lab eq $toplabel) {
+		$_ = 'redo LINE;';
+	    } else {
+		$_ = "goto $lab;";
+	    }
+	    next;
+	}
+
+	if (/^t$/) {
+	    $_ = 'next LINE if $tflag;';
+	    $tseen++;
+	    next;
+	}
+
+	if (/^t/) {
+	    s/^t[ \t]*//;
+	    $lab = &make_label($_);
+	    $_ = q/if ($tflag) {$tflag = ''; /;
+	    if ($lab eq $toplabel) {
+		$_ .= 'redo LINE;}';
+	    } else {
+		$_ .= "goto $lab;}";
+	    }
+	    $tseen++;
+	    next;
+	}
+
+	if (/^=/) {
+	    $_ = 'print "$.\n";';
+	    next;
+	}
+
+	if (/^q/) {
+	    chop($_ = <<'EOT');
+close(ARGV);
+@ARGV = ();
+next LINE;
+EOT
+	    next;
+	}
+    } continue {
+	if ($space) {
+	    s/^/$space/;
+	    s/(\n)(.)/$1$space$2/g;
+	}
+	last;
+    }
+    $_;
+}
+
+sub fetchpat {
+    local($outer) = @_;
+    local($addr) = $outer;
+    local($inbracket);
+    local($prefix,$delim,$ch);
+
+    # Process pattern one potential delimiter at a time.
+
+    DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
+	$prefix = $1;
+	$delim = $2;
+	if ($delim eq '\\') {
+	    s/(.)//;
+	    $ch = $1;
+	    $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
+	    $ch = 'b' if $ch =~ /^[<>]$/;
+	    $delim .= $ch;
+	}
+	elsif ($delim eq '[') {
+	    $inbracket = 1;
+	    s/^\^// && ($delim .= '^');
+	    s/^]// && ($delim .= ']');
+	}
+	elsif ($delim eq ']') {
+	    $inbracket = 0;
+	}
+	elsif ($inbracket || $delim ne $outer) {
+	    $delim = '\\' . $delim;
+	}
+	$addr .= $prefix;
+	$addr .= $delim;
+	if ($delim eq $outer && !$inbracket) {
+	    last DELIM;
+	}
+    }
+    $addr;
+}
diff --git a/os2/selfrun.bat b/os2/selfrun.bat
new file mode 100644
index 0000000000..9ec8a2920d
--- /dev/null
+++ b/os2/selfrun.bat
@@ -0,0 +1,12 @@
+@echo off
+perl -x %0.bat
+goto exit
+#!perl
+
+printf "
+This is a self-running perl script for DOS.
+
+"
+
+__END__
+:exit
diff --git a/os2/suffix.c b/os2/suffix.c
index 2dbb02b525..d766da37bc 100644
--- a/os2/suffix.c
+++ b/os2/suffix.c
@@ -134,13 +134,14 @@ char *s;
 
     switch(DosOpen(s, &hf, &usAction, 0L, 0, FILE_OPEN,
 	OPEN_ACCESS_READONLY | OPEN_SHARE_DENYNONE, 0L)) {
+    case ERROR_INVALID_NAME:
+    case ERROR_FILENAME_EXCED_RANGE:
+	return 0;
     case NO_ERROR:
 	DosClose(hf);
 	/*FALLTHROUGH*/
     default:
 	return 1;
-    case ERROR_FILENAME_EXCED_RANGE:
-	return 0;
     }
 }
 #endif /* OS2 */