perl 3.0 patch #26 patch #19, continued

See patch #19.

h2pl/eg/sysexits.pl

@@ -0,0 +1,16 @@
+$EX_OK = 0x0;
+$EX__BASE = 0x40;
+$EX_USAGE = 0x40;
+$EX_DATAERR = 0x41;
+$EX_NOINPUT = 0x42;
+$EX_NOUSER = 0x43;
+$EX_NOHOST = 0x44;
+$EX_UNAVAILABLE = 0x45;
+$EX_SOFTWARE = 0x46;
+$EX_OSERR = 0x47;
+$EX_OSFILE = 0x48;
+$EX_CANTCREAT = 0x49;
+$EX_IOERR = 0x4A;
+$EX_TEMPFAIL = 0x4B;
+$EX_PROTOCOL = 0x4C;
+$EX_NOPERM = 0x4D;

h2pl/tcbreak

@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+require 'cbreak.pl';
+
+&cbreak;
+
+$| = 1;
+
+print "gimme a char: ";
+
+$c = getc;
+
+print "$c\n";
+
+printf "you gave me `%s', which is 0x%02x\n", $c, ord($c);
+
+&cooked;

h2pl/tcbreak2

@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+require 'cbreak2.pl';
+
+&cbreak;
+
+$| = 1;
+
+print "gimme a char: ";
+
+$c = getc;
+
+print "$c\n";
+
+printf "you gave me `%s', which is 0x%02x\n", $c, ord($c);
+
+&cooked;

lib/stat.pl

@@ -1,6 +1,7 @@
-;# $Header: stat.pl,v 3.0 89/10/18 15:19:53 lwall Locked $
+;# $Header: stat.pl,v 3.0.1.1 90/08/09 04:01:34 lwall Locked $
 
 ;# Usage:
+;#	require 'stat.pl';
 ;#	@ary = stat(foo);
 ;#	$st_dev = @ary[$ST_DEV];
 ;#
@@ -19,6 +20,7 @@
 $ST_BLOCKS =	12 + $[;
 
 ;# Usage:
+;#	require 'stat.pl';
 ;#	do Stat('foo');		# sets st_* as a side effect
 ;#
 sub Stat {

lib/syslog.pl

@@ -8,7 +8,7 @@
 # call syslog() with a string priority and a list of printf() args
 # like syslog(3)
 #
-#  usage: do 'syslog.pl' || die "syslog.pl: $@";
+#  usage: require 'syslog.pl';
 #
 #  then (put these all in a script to test function)
 #		
@@ -29,8 +29,7 @@ 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";
+require 'syslog.ph';
 
 sub main'openlog {
     ($ident, $logopt, $facility) = @_;  # package vars

lib/termcap.pl

@@ -1,10 +1,10 @@
-;# $Header: termcap.pl,v 3.0.1.2 90/03/14 12:28:28 lwall Locked $
+;# $Header: termcap.pl,v 3.0.1.3 90/08/09 04:02:53 lwall Locked $
 ;#
 ;# Usage:
-;#	do 'ioctl.pl';
+;#	require 'ioctl.pl';
 ;#	ioctl(TTY,$TIOCGETP,$foo);
 ;#	($ispeed,$ospeed) = unpack('cc',$foo);
-;#	do 'termcap.pl' || die "Can't get termcap.pl";
+;#	require 'termcap.pl';
 ;#	&Tgetent('vt100');	# sets $TC{'cm'}, etc.
 ;#	&Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE');
 ;#	&Tputs($TC{'dl'},$affcnt,'FILEHANDLE');

os2/eg/syscalls.pl

@@ -0,0 +1,16 @@
+# OS/2 syscall values
+
+$OS2_GetVersion = 0;
+$OS2_Shutdown = 1;
+$OS2_Beep = 2;
+$OS2_PhysicalDisk = 3;
+$OS2_Config = 4;
+$OS2_IOCtl = 5;
+$OS2_QCurDisk = 6;
+$OS2_SelectDisk = 7;
+$OS2_SetMaxFH = 8;
+$OS2_Sleep = 9;
+$OS2_StartSession = 10;
+$OS2_StopSession = 11;
+$OS2_SelectSession = 12;
+1;

os2/suffix.c

@@ -0,0 +1,146 @@
+/*
+ * Suffix appending for in-place editing under MS-DOS and OS/2.
+ *
+ * Here are the rules:
+ *
+ * Style 0:  Append the suffix exactly as standard perl would do it.
+ *           If the filesystem groks it, use it.  (HPFS will always
+ *           grok it.  FAT will rarely accept it.)
+ *
+ * Style 1:  The suffix begins with a '.'.  The extension is replaced.
+ *           If the name matches the original name, use the fallback method.
+ *
+ * Style 2:  The suffix is a single character, not a '.'.  Try to add the 
+ *           suffix to the following places, using the first one that works.
+ *               [1] Append to extension.  
+ *               [2] Append to filename, 
+ *               [3] Replace end of extension, 
+ *               [4] Replace end of filename.
+ *           If the name matches the original name, use the fallback method.
+ *
+ * Style 3:  Any other case:  Ignore the suffix completely and use the
+ *           fallback method.
+ *
+ * Fallback method:  Change the extension to ".$$$".  If that matches the
+ *           original name, then change the extension to ".~~~".
+ *
+ * If filename is more than 1000 characters long, we die a horrible
+ * death.  Sorry.
+ *
+ * The filename restriction is a cheat so that we can use buf[] to store
+ * assorted temporary goo.
+ *
+ * Examples, assuming style 0 failed.
+ *
+ * suffix = ".bak" (style 1)
+ *                foo.bar => foo.bak
+ *                foo.bak => foo.$$$	(fallback)
+ *                foo.$$$ => foo.~~~	(fallback)
+ *                makefile => makefile.bak
+ *
+ * suffix = "~" (style 2)
+ *                foo.c => foo.c~
+ *                foo.c~ => foo.c~~
+ *                foo.c~~ => foo~.c~~
+ *                foo~.c~~ => foo~~.c~~
+ *                foo~~~~~.c~~ => foo~~~~~.$$$ (fallback)
+ *
+ *                foo.pas => foo~.pas
+ *                makefile => makefile.~
+ *                longname.fil => longname.fi~
+ *                longname.fi~ => longnam~.fi~
+ *                longnam~.fi~ => longnam~.$$$
+ *                
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#ifdef OS2
+#define INCL_DOSFILEMGR
+#define INCL_DOSERRORS
+#include <os2.h>
+#endif /* OS2 */
+
+static char suffix1[] = ".$$$";
+static char suffix2[] = ".~~~";
+
+#define ext (&buf[1000])
+
+add_suffix(str,suffix)
+register STR *str;
+register char *suffix;
+{
+    int baselen;
+    int extlen;
+    char *s, *t, *p;
+    STRLEN slen;
+
+    if (!(str->str_pok)) (void)str_2ptr(str);
+    if (str->str_cur > 1000)
+        fatal("Cannot do inplace edit on long filename (%d characters)", str->str_cur);
+
+#ifdef OS2
+    /* Style 0 */
+    slen = str->str_cur;
+    str_cat(str, suffix);
+    if (valid_filename(str->str_ptr)) return;
+
+    /* Fooey, style 0 failed.  Fix str before continuing. */
+    str->str_ptr[str->str_cur = slen] = '\0';
+#endif /* OS2 */
+
+    slen = strlen(suffix);
+    t = buf; baselen = 0; s = str->str_ptr;
+    while ( (*t = *s) && *s != '.') {
+	baselen++;
+	if (*s == '\\' || *s == '/') baselen = 0;
+ 	s++; t++;
+    }
+    p = t;
+
+    t = ext; extlen = 0;
+    while (*t++ = *s++) extlen++;
+    if (extlen == 0) { ext[0] = '.'; ext[1] = 0; extlen++; }
+
+    if (*suffix == '.') {        /* Style 1 */
+        if (strEQ(ext, suffix)) goto fallback;
+	strcpy(p, suffix);
+    } else if (suffix[1] == '\0') {  /* Style 2 */
+        if (extlen < 4) { 
+	    ext[extlen] = *suffix;
+	    ext[++extlen] = '\0';
+        } else if (baselen < 8) {
+   	    *p++ = *suffix;
+	} else if (ext[3] != *suffix) {
+	    ext[3] = *suffix;
+	} else if (buf[7] != *suffix) {
+	    buf[7] = *suffix;
+	} else goto fallback;
+	strcpy(p, ext);
+    } else { /* Style 3:  Panic */
+fallback:
+	(void)bcopy(strEQ(ext, suffix1) ? suffix2 : suffix1, p, 4+1);
+    }
+    str_set(str, buf);
+}
+
+#ifdef OS2
+int 
+valid_filename(s)
+char *s;
+{
+    HFILE hf;
+    USHORT usAction;
+
+    switch(DosOpen(s, &hf, &usAction, 0L, 0, FILE_OPEN,
+	OPEN_ACCESS_READONLY | OPEN_SHARE_DENYNONE, 0L)) {
+    case NO_ERROR:
+	DosClose(hf);
+	/*FALLTHROUGH*/
+    default:
+	return 1;
+    case ERROR_FILENAME_EXCED_RANGE:
+	return 0;
+    }
+}
+#endif /* OS2 */

patchlevel.h

@@ -1 +1 @@
-#define PATCHLEVEL 25
+#define PATCHLEVEL 26

stab.h

@@ -1,11 +1,14 @@
-/* $Header: stab.h,v 3.0.1.2 90/03/12 17:00:43 lwall Locked $
+/* $Header: stab.h,v 3.0.1.3 90/08/09 05:18:42 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
  *    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:	stab.h,v $
+ * Revision 3.0.1.3  90/08/09  05:18:42  lwall
+ * patch19: Added support for linked-in C subroutines
+ * 
  * Revision 3.0.1.2  90/03/12  17:00:43  lwall
  * patch13: did some ndir straightening up for Xenix
  * 
@@ -88,6 +91,8 @@ struct stio {
 
 struct sub {
     CMD		*cmd;
+    int		(*usersub)();
+    int		userindex;
     char	*filename;
     long	depth;	/* >= 2 indicates recursive call */
     ARRAY	*tosave;