perl 4.0 patch 18: patch #11, continued
authorLarry Wall <lwall@netlabs.com>
Tue, 5 Nov 1991 09:55:53 +0000 (09:55 +0000)
committerLarry Wall <lwall@netlabs.com>
Tue, 5 Nov 1991 09:55:53 +0000 (09:55 +0000)
See patch #11.

22 files changed:
MANIFEST
arg.h
array.c
cmd.c
form.c
h2ph.SH
handy.h
hints/aix_rs.sh
hints/greenhills.sh [new file with mode: 0644]
lib/cacheout.pl
lib/complete.pl
lib/getcwd.pl [new file with mode: 0644]
lib/getopt.pl
lib/getopts.pl
makedepend.SH
patchlevel.h
regcomp.c
regexp.h
t/op/sort.t
usub/README
x2p/util.h
x2p/walk.c

index 60d1ba2..ca59619 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -13,6 +13,8 @@ Wishlist              Some things that may or may not happen
 arg.h                  Public declarations for the above
 array.c                        Numerically subscripted arrays
 array.h                        Public declarations for the above
+c2ph.SH                        program to translate dbx stabs to perl
+c2ph.doc               documentation for c2ph
 cflags.SH              A script that emits C compilation flags per file
 client                 A client to test sockets
 cmd.c                  Command interpreter
@@ -65,9 +67,9 @@ eg/van/unvanish               A program to undo what vanish does
 eg/van/vanexp          A program to expire vanished files
 eg/van/vanish          A program to put files in a trashcan
 eg/who                 A sample who program
-emacs/perldb.pl                Emacs debugging
-emacs/perldb.el                Emacs debugging
 emacs/perl-mode.el     Emacs major mode for perl
+emacs/perldb.el                Emacs debugging
+emacs/perldb.pl                Emacs debugging
 emacs/tedstuff         Some optional patches
 eval.c                 The expression evaluator
 form.c                 Format processing
@@ -93,19 +95,25 @@ hints/3b1.sh
 hints/3b2.sh
 hints/aix_rs.sh
 hints/aix_rt.sh
+hints/altos486.sh      
 hints/apollo_C6_7.sh
+hints/apollo_C6_8.sh   
 hints/aux.sh
 hints/dnix.sh
 hints/dynix.sh
 hints/fps.sh
 hints/genix.sh
+hints/greenhills.sh    
 hints/hp9000_300.sh
 hints/hp9000_400.sh
+hints/hp9000_800.sh    
 hints/hpux.sh
 hints/i386.sh
 hints/mips.sh
+hints/mpc.sh   
 hints/ncr_tower.sh
 hints/next.sh
+hints/opus.sh  
 hints/osf_1.sh
 hints/sco_2_3_0.sh
 hints/sco_2_3_1.sh
@@ -113,11 +121,13 @@ hints/sco_2_3_2.sh
 hints/sco_2_3_3.sh
 hints/sco_3.sh
 hints/sgi.sh
+hints/stellar.sh       
 hints/sunos_3_4.sh
 hints/sunos_3_5.sh
 hints/sunos_4_0_1.sh
 hints/sunos_4_0_2.sh
 hints/svr4.sh
+hints/ti1500.sh        
 hints/ultrix_3.sh
 hints/ultrix_4.sh
 hints/uts.sh
@@ -125,16 +135,21 @@ hints/vax.sh
 installperl            Perl script to do "make install" dirty work
 ioctl.pl               Sample ioctl.pl
 lib/abbrev.pl          An abbreviation table builder
+lib/assert.pl          assertion and panic with stack trace
 lib/bigfloat.pl                An arbitrary precision floating point package
 lib/bigint.pl          An arbitrary precision integer arithmetic package
 lib/bigrat.pl          An arbitrary precision rational arithmetic package
 lib/cacheout.pl                Manages output filehandles when you need too many
+lib/chat2.pl           Randal's famous expect-ish routines
 lib/complete.pl                A command completion subroutine
 lib/ctime.pl           A ctime workalike
 lib/dumpvar.pl         A variable dumper
+lib/exceptions.pl      catch and throw routines
+lib/fastcwd.pl         a faster but more dangerous getcwd
 lib/find.pl            A find emulator--used by find2perl
 lib/finddepth.pl       A depth-first find emulator--used by find2perl
 lib/flush.pl           Routines to do single flush
+lib/getcwd.pl          a getcwd() emulator
 lib/getopt.pl          Perl library supporting option parsing
 lib/getopts.pl         Perl library supporting option parsing
 lib/importenv.pl       Perl routine to get environment into variables
@@ -155,8 +170,8 @@ msdos/Changes.dds   Expanation of MS-DOS patches by Diomidis Spinellis
 msdos/Makefile         MS-DOS makefile
 msdos/README.msdos     Compiling and usage information
 msdos/Wishlist.dds     My wishlist
-msdos/config.h         Definitions for msdos
 msdos/chdir.c          A chdir that can change drives
+msdos/config.h         Definitions for msdos
 msdos/dir.h            MS-DOS header for directory access functions
 msdos/directory.c      MS-DOS directory access functions.
 msdos/eg/crlf.bat      Convert files from unix to MS-DOS line termination
@@ -200,8 +215,8 @@ perl.c                      main()
 perl.h                 Global declarations
 perl.man               The manual page(s)
 perlsh                 A poor man's perl shell
-perly.y                        Yacc grammar for perl
 perly.fixer            A program to remove yacc stack limitations
+perly.y                        Yacc grammar for perl
 regcomp.c              Regular expression compiler
 regcomp.h              Private declarations for above
 regexec.c              Regular expression evaluator
@@ -270,6 +285,7 @@ t/op/pack.t         See if pack and unpack work
 t/op/pat.t             See if esoteric patterns work
 t/op/push.t            See if push and pop work
 t/op/range.t           See if .. works
+t/op/re_tests          Input file for op.regexp
 t/op/read.t            See if read() works
 t/op/regexp.t          See if regular expressions work
 t/op/repeat.t          See if x operator works
@@ -286,11 +302,11 @@ t/op/undef.t              See if undef works
 t/op/unshift.t         See if unshift works
 t/op/vec.t             See if vectors work
 t/op/write.t           See if write works
-t/op/re_tests          Input file for op.regexp
 toke.c                 The tokener
 usersub.c              User supplied (possibly proprietary) subroutines
-usub/README            Instructions for user supplied subroutines
 usub/Makefile          Makefile for curseperl
+usub/README            Instructions for user supplied subroutines
+usub/bsdcurses.mus     what used to be curses.mus
 usub/curses.mus                Glue routines for BSD curses
 usub/man2mus           A manual page to .mus translator
 usub/mus               A .mus to .c translator
diff --git a/arg.h b/arg.h
index ee5aade..bd2c43d 100644 (file)
--- a/arg.h
+++ b/arg.h
@@ -1,4 +1,4 @@
-/* $RCSfile: arg.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:18:30 $
+/* $RCSfile: arg.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 15:51:05 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       arg.h,v $
+ * Revision 4.0.1.2  91/11/05  15:51:05  lwall
+ * patch11: added eval {}
+ * patch11: added sort {} LIST
+ * 
  * Revision 4.0.1.1  91/06/07  10:18:30  lwall
  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  * patch4: new copyright notice
 #define O_CLOSEDIR 264
 #define O_SYSCALL 265
 #define O_PIPE 266
-#define MAXO 267
+#define O_TRY 267
+#define O_EVALONCE 268
+#define MAXO 269
 
 #ifndef DOINIT
 extern char *opname[];
@@ -556,7 +562,9 @@ char *opname[] = {
     "CLOSEDIR",
     "SYSCALL",
     "PIPE",
-    "267"
+    "TRY",
+    "EVALONCE",
+    "269"
 };
 #endif
 
@@ -957,6 +965,8 @@ unsigned short opargs[MAXO+1] = {
        A(1,0,0),       /* CLOSEDIR */
        A(1,3,0),       /* SYSCALL */
        A(1,1,0),       /* PIPE */
+       A(0,0,0),       /* TRY */
+       A(1,0,0),       /* EVALONCE */
        0
 };
 #undef A
diff --git a/array.c b/array.c
index e2561d7..fb2801f 100644 (file)
--- a/array.c
+++ b/array.c
@@ -1,4 +1,4 @@
-/* $RCSfile: array.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:19:08 $
+/* $RCSfile: array.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 16:00:14 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       array.c,v $
+ * Revision 4.0.1.2  91/11/05  16:00:14  lwall
+ * patch11: random cleanup
+ * patch11: passing non-existend array elements to subrouting caused core dump
+ * 
  * Revision 4.0.1.1  91/06/07  10:19:08  lwall
  * patch4: new copyright notice
  * 
@@ -87,17 +91,21 @@ STR *val;
            ar->ary_max = newmax;
        }
     }
-    if ((ar->ary_flags & ARF_REAL) && ar->ary_fill < key) {
-       while (++ar->ary_fill < key) {
-           if (ar->ary_array[ar->ary_fill] != Nullstr) {
-               str_free(ar->ary_array[ar->ary_fill]);
-               ar->ary_array[ar->ary_fill] = Nullstr;
+    if (ar->ary_flags & ARF_REAL) {
+       if (ar->ary_fill < key) {
+           while (++ar->ary_fill < key) {
+               if (ar->ary_array[ar->ary_fill] != Nullstr) {
+                   str_free(ar->ary_array[ar->ary_fill]);
+                   ar->ary_array[ar->ary_fill] = Nullstr;
+               }
            }
        }
+       retval = (ar->ary_array[key] != Nullstr);
+       if (retval)
+           str_free(ar->ary_array[key]);
     }
-    retval = (ar->ary_array[key] != Nullstr);
-    if (retval && (ar->ary_flags & ARF_REAL))
-       str_free(ar->ary_array[key]);
+    else
+       retval = 0;
     ar->ary_array[key] = val;
     return retval;
 }
@@ -135,7 +143,9 @@ register STR **strp;
     ar->ary_max = size - 1;
     ar->ary_flags = 0;
     while (size--) {
-       (*strp++)->str_pok &= ~SP_TEMP;
+       if (*strp)
+           (*strp)->str_pok &= ~SP_TEMP;
+       strp++;
     }
     return ar;
 }
@@ -148,6 +158,7 @@ register ARRAY *ar;
 
     if (!ar || !(ar->ary_flags & ARF_REAL) || ar->ary_max < 0)
        return;
+    /*SUPPRESS 560*/
     if (key = ar->ary_array - ar->ary_alloc) {
        ar->ary_max += key;
        ar->ary_array -= key;
@@ -166,6 +177,7 @@ register ARRAY *ar;
 
     if (!ar)
        return;
+    /*SUPPRESS 560*/
     if (key = ar->ary_array - ar->ary_alloc) {
        ar->ary_max += key;
        ar->ary_array -= key;
@@ -222,7 +234,7 @@ register int num;
 #ifdef BUGGY_MSC5
  # pragma loop_opt(off)        /* don't loop-optimize the following code */
 #endif /* BUGGY_MSC5 */
-       for (i = ar->ary_fill; i >= 0; i--) {
+       for (i = ar->ary_fill - num; i >= 0; i--) {
            *dstr-- = *sstr--;
 #ifdef BUGGY_MSC5
  # pragma loop_opt()   /* loop-optimization back to command-line setting */
diff --git a/cmd.c b/cmd.c
index 06951b5..2509509 100644 (file)
--- a/cmd.c
+++ b/cmd.c
@@ -1,4 +1,4 @@
-/* $RCSfile: cmd.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:26:45 $
+/* $RCSfile: cmd.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 16:07:43 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       cmd.c,v $
+ * Revision 4.0.1.3  91/11/05  16:07:43  lwall
+ * patch11: random cleanup
+ * patch11: "foo\0" eq "foo" was sometimes optimized to true
+ * patch11: foreach on null list could spring memory leak
+ * 
  * Revision 4.0.1.2  91/06/07  10:26:45  lwall
  * patch4: new copyright notice
  * patch4: made some allowances for "semi-standard" C
@@ -230,7 +235,8 @@ tail_recursion_entry:
 #endif
                    newsp = cmd_exec(cmd->ucmd.ccmd.cc_true,gimme && (cmdflags & CF_TERM),sp);
                    st = stack->ary_array;      /* possibly reallocated */
-                   retstr = st[newsp];
+                   if (newsp >= 0)
+                       retstr = st[newsp];
                }
                if (!goto_targ) {
                    go_to = Nullch;
@@ -250,7 +256,8 @@ tail_recursion_entry:
 #endif
                    newsp = cmd_exec(cmd->ucmd.ccmd.cc_alt,gimme && (cmdflags & CF_TERM),sp);
                    st = stack->ary_array;      /* possibly reallocated */
-                   retstr = st[newsp];
+                   if (newsp >= 0)
+                       retstr = st[newsp];
                }
                if (goto_targ)
                    break;
@@ -331,12 +338,18 @@ until_loop:
                else
                    break;              /* must evaluate */
            }
-           /* FALL THROUGH */
+           match = 0;
+           goto strop;
+
        case CFT_STROP:         /* string op optimization */
+           match = 1;
+         strop:
            retstr = STAB_STR(cmd->c_stab);
            newsp = -2;
 #ifndef I286
            if (*cmd->c_short->str_ptr == *str_get(retstr) &&
+                   (match ? retstr->str_cur == cmd->c_slen - 1 :
+                            retstr->str_cur >= cmd->c_slen) &&
                    bcmp(cmd->c_short->str_ptr, str_get(retstr),
                      cmd->c_slen) == 0 ) {
                if (cmdflags & CF_EQSURE) {
@@ -576,6 +589,9 @@ until_loop:
            }
 
            if (match >= ar->ary_fill) {        /* we're in LAST, probably */
+               if (match < 0 &&                /* er, probably not... */
+                 savestack->ary_fill > aryoptsave)
+                   restorelist(aryoptsave);
                retstr = &str_undef;
                cmd->c_short->str_u.str_useful = -1;    /* actually redundant */
                match = FALSE;
diff --git a/form.c b/form.c
index 27835fe..701aa05 100644 (file)
--- a/form.c
+++ b/form.c
@@ -1,4 +1,4 @@
-/* $RCSfile: form.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:07:59 $
+/* $RCSfile: form.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 17:18:43 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       form.c,v $
+ * Revision 4.0.1.2  91/11/05  17:18:43  lwall
+ * patch11: formats didn't fill their fields as well as they could
+ * patch11: ^ fields chopped hyphens on line break
+ * patch11: # fields could write outside allocated memory
+ * 
  * Revision 4.0.1.1  91/06/07  11:07:59  lwall
  * patch4: new copyright notice
  * patch4: default top-of-form format is now FILEHANDLE_TOP
@@ -97,6 +102,7 @@ int sp;
     for (; fcmd; fcmd = nextfcmd) {
        nextfcmd = fcmd->f_next;
        CHKLEN(fcmd->f_presize);
+       /*SUPPRESS 560*/
        if (s = fcmd->f_pre) {
            while (*s) {
                if (*s == '\n') {
@@ -141,7 +147,7 @@ int sp;
                if (*s == '\n' && (fcmd->f_flags & FC_CHOP))
                    *s = ' ';
            }
-           if (size)
+           if (size || !*s)
                chophere = s;
            else if (chophere && chophere < s && *s && index(chopset,*s))
                chophere = s;
@@ -165,7 +171,8 @@ int sp;
                    *d++ = '.';
                    size -= 3;
                }
-               while (*chophere && index(chopset,*chophere))
+               while (*chophere && index(chopset,*chophere)
+                 && isSPACE(*chophere))
                    chophere++;
                str_chop(str,chophere);
            }
@@ -192,7 +199,7 @@ int sp;
                if (*s == '\n' && (fcmd->f_flags & FC_CHOP))
                    *s = ' ';
            }
-           if (size)
+           if (size || !*s)
                chophere = s;
            else if (chophere && chophere < s && *s && index(chopset,*s))
                chophere = s;
@@ -201,7 +208,8 @@ int sp;
                    chophere = s;
                size += (s - chophere);
                s = chophere;
-               while (*chophere && index(chopset,*chophere))
+               while (*chophere && index(chopset,*chophere)
+                 && isSPACE(*chophere))
                    chophere++;
            }
            tmpchar = *s;
@@ -235,7 +243,7 @@ int sp;
                if (*s == '\n' && (fcmd->f_flags & FC_CHOP))
                    *s = ' ';
            }
-           if (size)
+           if (size || !*s)
                chophere = s;
            else if (chophere && chophere < s && *s && index(chopset,*s))
                chophere = s;
@@ -244,7 +252,8 @@ int sp;
                    chophere = s;
                size += (s - chophere);
                s = chophere;
-               while (*chophere && index(chopset,*chophere))
+               while (*chophere && index(chopset,*chophere)
+                 && isSPACE(*chophere))
                    chophere++;
            }
            tmpchar = *s;
@@ -291,7 +300,7 @@ int sp;
            (void)eval(fcmd->f_expr,G_SCALAR,sp);
            str = stack->ary_array[sp+1];
            size = fcmd->f_size;
-           CHKLEN(size);
+           CHKLEN(size+1);
            /* If the field is marked with ^ and the value is undefined,
               blank it out. */
            if ((fcmd->f_flags & FC_CHOP) && !str->str_pok && !str->str_nok) {
diff --git a/h2ph.SH b/h2ph.SH
index 1e5ac0b..90fd41f 100644 (file)
--- a/h2ph.SH
+++ b/h2ph.SH
@@ -24,7 +24,7 @@ $spitshell >h2ph <<!GROK!THIS!
 'di';
 'ig00';
 
-\$perlincl = '$privlib';
+\$perlincl = '$installprivlib';
 !GROK!THIS!
 
 : In the following dollars and backticks do not need the extra backslash.
@@ -40,7 +40,7 @@ chdir '/usr/include' || die "Can't cd /usr/include";
        FILE
 END
 
-$isatype{@isatype} = (1) x @isatype;
+@isatype{@isatype} = (1) x @isatype;
 
 @ARGV = ('-') unless @ARGV;
 
@@ -86,6 +86,7 @@ foreach $file (@ARGV) {
                    $args = $1;
                    if ($args ne '') {
                        foreach $arg (split(/,\s*/,$args)) {
+                           $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
                            $curargs{$arg} = 1;
                        }
                        $args =~ s/\b(\w)/\$$1/g;
@@ -117,7 +118,7 @@ foreach $file (@ARGV) {
                    }
                }
            }
-           elsif (/^include <(.*)>/) {
+           elsif (/^include\s+<(.*)>/) {
                ($incl = $1) =~ s/\.h$/.ph/;
                print OUT $t,"require '$incl';\n";
            }
diff --git a/handy.h b/handy.h
index da31d7a..62cef86 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -1,4 +1,4 @@
-/* $RCSfile: handy.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:09:56 $
+/* $RCSfile: handy.h,v $$Revision: 4.0.1.3 $$Date: 91/11/05 22:54:26 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,12 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       handy.h,v $
+ * Revision 4.0.1.3  91/11/05  22:54:26  lwall
+ * patch11: erratum
+ * 
+ * Revision 4.0.1.2  91/11/05  17:23:38  lwall
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
  * Revision 4.0.1.1  91/06/07  11:09:56  lwall
  * patch4: new copyright notice
  * 
 #define strnNE(s1,s2,l) (strncmp(s1,s2,l))
 #define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
 
+#if defined(CTYPE256) || !defined(isascii)
+#define isALNUM(c) (isalpha(c) || isdigit(c) || c == '_')
+#define isALPHA(c) isalpha(c)
+#define isSPACE(c) isspace(c)
+#define isDIGIT(c) isdigit(c)
+#define isUPPER(c) isupper(c)
+#define isLOWER(c) islower(c)
+#else
+#define isALNUM(c) (isascii(c) && (isalpha(c) || isdigit(c) || c == '_'))
+#define isALPHA(c) (isascii(c) && isalpha(c))
+#define isSPACE(c) (isascii(c) && isspace(c))
+#define isDIGIT(c) (isascii(c) && isdigit(c))
+#define isUPPER(c) (isascii(c) && isupper(c))
+#define isLOWER(c) (isascii(c) && islower(c))
+#endif
+
 #define MEM_SIZE unsigned int
 
 /* Line numbers are unsigned, 16 bits. */
@@ -64,9 +86,11 @@ typedef unsigned short line_t;
 
 #ifndef lint
 #ifndef LEAKTEST
+#ifndef safemalloc
 char *safemalloc();
 char *saferealloc();
 void safefree();
+#endif
 #ifndef MSDOS
 #define New(x,v,n,t)  (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
 #define Newc(x,v,n,t,c)  (v = (c*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
index 8f31a03..17b22a1 100644 (file)
@@ -1,4 +1,5 @@
 eval_cflags='optimize="-g"'
 toke_cflags='optimize="-g"'
 teval_cflags='optimize="-g"'
-ttoke_cflags='optimize="-g"'; cflags="$cflags -D_NO_PROTO"
+ttoke_cflags='optimize="-g"';
+ccflags="$ccflags -D_NO_PROTO"
diff --git a/hints/greenhills.sh b/hints/greenhills.sh
new file mode 100644 (file)
index 0000000..da6fcc9
--- /dev/null
@@ -0,0 +1 @@
+ccflags="$ccflags -X18"
index 106014c..bec40bd 100644 (file)
@@ -12,11 +12,9 @@ sub cacheout {
     package cacheout;
 
     ($file) = @_;
-    ($package) = caller;
     if (!$isopen{$file}) {
        if (++$numopen > $maxopen) {
-           sub byseq {$isopen{$a} != $isopen{$b};}
-           local(@lru) = sort byseq keys(%isopen);
+           local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen);
            splice(@lru, $maxopen / 3);
            $numopen -= @lru;
            for (@lru) { close $_; delete $isopen{$_}; }
@@ -35,7 +33,7 @@ $numopen = 0;
 if (open(PARAM,'/usr/include/sys/param.h')) {
     local($.);
     while (<PARAM>) {
-       $maxopen = $1 - 4 if /^#define NOFILE\s+(\d+)/;
+       $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/;
     }
     close PARAM;
 }
index 73d3649..dabf8f6 100644 (file)
@@ -1,5 +1,5 @@
 ;#
-;#     @(#)complete.pl 1.0 (sun!waynet) 11/11/88
+;#      @(#)complete.pl,v1.1            (me@anywhere.EBay.Sun.COM) 09/23/91
 ;#
 ;# Author: Wayne Thompson
 ;#
@@ -7,7 +7,7 @@
 ;#     This routine provides word completion.
 ;#     (TAB) attempts word completion.
 ;#     (^D)  prints completion list.
-;#     (These may be changed by setting $Complete'complete, etc.)
+;#      (These may be changed by setting $Complete'complete, etc.)
 ;#
 ;# Diagnostics:
 ;#     Bell when word completion fails.
 ;# Bugs:
 ;#
 ;# Usage:
-;#     $input = do Complete('prompt_string', @completion_list);
+;#     $input = &Complete('prompt_string', *completion_list);
+;#         or
+;#     $input = &Complete('prompt_string', @completion_list);
 ;#
 
 CONFIG: {
     package Complete;
 
-    $complete =        "\004";
-    $kill =    "\025";
-    $erase1 =  "\177";
-    $erase2 =  "\010";
+    $complete = "\004";
+    $kill     = "\025";
+    $erase1 =   "\177";
+    $erase2 =   "\010";
 }
 
 sub Complete {
     package Complete;
 
-    local ($prompt) = shift (@_);
-    local ($c, $cmp, $l, $r, $ret, $return, $test);
-    @_cmp_lst = sort @_;
     local($[) = 0;
-    system 'stty raw -echo';
-    loop: {
-       print $prompt, $return;
-       while (($c = getc(stdin)) ne "\r") {
-           if ($c eq "\t") {                   # (TAB) attempt completion
-               @_match = ();
-               foreach $cmp (@_cmp_lst) {
-                   push (@_match, $cmp) if $cmp =~ /^$return/;
-               }
-               $test = $_match[0];
-               $l = length ($test);
-               unless ($#_match == 0) {
-                   shift (@_match);
-                   foreach $cmp (@_match) {
-                       until (substr ($cmp, 0, $l) eq substr ($test, 0, $l)) {
-                           $l--;
-                       }
-                   }
-                   print "\007";
-               }
-               print $test = substr ($test, $r, $l - $r);
-               $r = length ($return .= $test);
-           }
-           elsif ($c eq $complete) {           # (^D) completion list
-               print "\r\n";
-               foreach $cmp (@_cmp_lst) {
-                   print "$cmp\r\n" if $cmp =~ /^$return/;
-               }
-               redo loop;
-           }
-           elsif ($c eq $kill && $r) { # (^U) kill
-               $return = '';
-               $r = 0;
-               print "\r\n";
-               redo loop;
-           }
-                                               # (DEL) || (BS) erase
-           elsif ($c eq $erase1 || $c eq $erase2) {
-               if($r) {
-                   print "\b \b";
-                   chop ($return);
-                   $r--;
-               }
-           }
-           elsif ($c =~ /\S/) {                # printable char
-               $return .= $c;
-               $r++;
-               print $c;
-           }
-       }
+    if ($_[1] =~ /^StB\0/) {
+        ($prompt, *_) = @_;
     }
-    system 'stty -raw echo';
-    print "\n";
+    else {
+        $prompt = shift(@_);
+    }
+    @cmp_lst = sort(@_);
+
+    system('stty raw -echo');
+    LOOP: {
+        print($prompt, $return);
+        while (($_ = getc(STDIN)) ne "\r") {
+            CASE: {
+                # (TAB) attempt completion
+                $_ eq "\t" && do {
+                    @match = grep(/^$return/, @cmp_lst);
+                    $l = length($test = shift(@match));
+                    unless ($#match < 0) {
+                        foreach $cmp (@match) {
+                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
+                                $l--;
+                            }
+                        }
+                        print("\a");
+                    }
+                    print($test = substr($test, $r, $l - $r));
+                    $r = length($return .= $test);
+                    last CASE;
+                };
+
+                # (^D) completion list
+                $_ eq $complete && do {
+                    print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n");
+                    redo LOOP;
+                };
+
+                # (^U) kill
+                $_ eq $kill && do {
+                    if ($r) {
+                        undef($r, $return);
+                        print("\r\n");
+                        redo LOOP;
+                    }
+                    last CASE;
+                };
+
+                # (DEL) || (BS) erase
+                ($_ eq $erase1 || $_ eq $erase2) && do {
+                    if($r) {
+                        print("\b \b");
+                        chop($return);
+                        $r--;
+                    }
+                    last CASE;
+                };
+
+                # printable char
+                ord >= 32 && do {
+                    $return .= $_;
+                    $r++;
+                    print;
+                    last CASE;
+                };
+            }
+        }
+    }
+    system('stty -raw echo');
+    print("\n");
     $return;
 }
 
diff --git a/lib/getcwd.pl b/lib/getcwd.pl
new file mode 100644 (file)
index 0000000..114e890
--- /dev/null
@@ -0,0 +1,62 @@
+# By Brandon S. Allbery
+#
+# Usage: $cwd = &getcwd;
+
+sub getcwd
+{
+    local($dotdots, $cwd, @pst, @cst, $dir, @tst);
+
+    unless (@cst = stat('.'))
+    {
+       warn "stat(.): $!";
+       return '';
+    }
+    $cwd = '';
+    do
+    {
+       $dotdots .= '/' if $dotdots;
+       $dotdots .= '..';
+       @pst = @cst;
+       unless (opendir(getcwd'PARENT, $dotdots))                       #'))
+       {
+           warn "opendir($dotdots): $!";
+           return '';
+       }
+       unless (@cst = stat($dotdots))
+       {
+           warn "stat($dotdots): $!";
+           closedir(getcwd'PARENT);                                    #');
+           return '';
+       }
+       if ($pst[$[] == $cst[$[] && $pst[$[ + 1] == $cst[$[ + 1])
+       {
+           $dir = '';
+       }
+       else
+       {
+           do
+           {
+               unless ($dir = readdir(getcwd'PARENT))                  #'))
+               {
+                   warn "readdir($dotdots): $!";
+                   closedir(getcwd'PARENT);                            #');
+                   return '';
+               }
+               unless (@tst = stat("$dotdots/$dir"))
+               {
+                   warn "stat($dotdots/$dir): $!";
+                   closedir(getcwd'PARENT);                            #');
+                   return '';
+               }
+           }
+           while ($dir eq '.' || $dir eq '..' || $tst[$[] != $pst[$[] ||
+                  $tst[$[ + 1] != $pst[$[ + 1]);
+       }
+       $cwd = "$dir/$cwd";
+       closedir(getcwd'PARENT);                                        #');
+    } while ($dir);
+    chop($cwd);
+    $cwd;
+}
+
+1;
index da39d3b..b9d7b5b 100644 (file)
@@ -1,4 +1,4 @@
-;# $Header: getopt.pl,v 4.0 91/03/20 01:25:11 lwall Locked $
+;# $RCSfile: getopt.pl,v $$Revision: 4.0.1.1 $$Date: 91/11/05 17:53:01 $
 
 ;# Process single-character switches with switch clustering.  Pass one argument
 ;# which is a string containing all switches that take an argument.  For each
@@ -14,7 +14,7 @@ sub Getopt {
     local($_,$first,$rest);
     local($[) = 0;
 
-    while (($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
        ($first,$rest) = ($1,$2);
        if (index($argumentative,$first) >= $[) {
            if ($rest ne '') {
index 4ed3a05..6590918 100644 (file)
@@ -6,11 +6,12 @@
 
 sub Getopts {
     local($argumentative) = @_;
-    local(@args,$_,$first,$rest,$errs);
+    local(@args,$_,$first,$rest);
+    local($errs) = 0;
     local($[) = 0;
 
     @args = split( / */, $argumentative );
-    while(($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
        ($first,$rest) = ($1,$2);
        $pos = index($argumentative,$first);
        if($pos >= $[) {
index 2f94175..8fb59cd 100644 (file)
@@ -15,9 +15,12 @@ esac
 echo "Extracting makedepend (with variable substitutions)"
 $spitshell >makedepend <<!GROK!THIS!
 $startsh
-# $RCSfile: makedepend.SH,v $$Revision: 4.0.1.2 $$Date: 91/06/07 15:40:06 $
+# $RCSfile: makedepend.SH,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:56:33 $
 #
 # $Log:        makedepend.SH,v $
+# Revision 4.0.1.3  91/11/05  17:56:33  lwall
+# patch11: various portability fixes
+# 
 # Revision 4.0.1.2  91/06/07  15:40:06  lwall
 # patch4: fixed cppstdin to run in the right directory
 # 
@@ -92,7 +95,8 @@ for file in `$cat .clist`; do
        -e '}'
     $cppstdin -I/usr/local/include -I. $cppflags $cppminus <$file.c | sed -e 's#\.[0-9][0-9]*\.c#'"$file.c#" | \
     $sed \
-       -e '/^# *[0-9]/!d' \
+       -e 's/^[         ]*#[    ]*line/#/' \
+       -e '/^# *[0-9][0-9]* *"/!d' \
        -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
        -e 's|: \./|: |' \
        -e 's|\.c\.c|.c|' | \
index 6dbf069..1af605e 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 17
+#define PATCHLEVEL 18
index 0fd50c0..fd8d422 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -7,9 +7,12 @@
  * blame Henry for some of the lack of readability.
  */
 
-/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:22:28 $
+/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 22:55:14 $
  *
  * $Log:       regcomp.c,v $
+ * Revision 4.0.1.4  91/11/05  22:55:14  lwall
+ * patch11: Erratum
+ * 
  * Revision 4.0.1.3  91/11/05  18:22:28  lwall
  * patch11: minimum match length calculation in regexp is now cumulative
  * patch11: initial .* in pattern had dependency on value of $*
@@ -157,7 +160,9 @@ int fold;
        int backest;
        int curback;
        int minlen;
+#ifndef safemalloc
        extern char *safemalloc();
+#endif
        extern char *savestr();
        int sawplus = 0;
        int sawopen = 0;
index 5731874..33d9e32 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -5,9 +5,13 @@
  * not the System V one.
  */
 
-/* $RCSfile: regexp.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:51:18 $
+/* $RCSfile: regexp.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:24:31 $
  *
  * $Log:       regexp.h,v $
+ * Revision 4.0.1.2  91/11/05  18:24:31  lwall
+ * patch11: minimum match length calculation in regexp is now cumulative
+ * patch11: initial .* in pattern had dependency on value of $*
+ * 
  * Revision 4.0.1.1  91/06/07  11:51:18  lwall
  * patch4: new copyright notice
  * patch4: // wouldn't use previous pattern if it started with a null character
@@ -25,6 +29,7 @@ typedef struct regexp {
        char *regstclass;
        STR *regmust;           /* Internal use only. */
        int regback;            /* Can regmust locate first try? */
+       int minlen;             /* mininum possible length of $& */
        int prelen;             /* length of precomp */
        char *precomp;          /* pre-compilation regular expression */
        char *subbase;          /* saved string so \digit works forever */
@@ -39,6 +44,7 @@ typedef struct regexp {
 
 #define ROPT_ANCH 1
 #define ROPT_SKIP 2
+#define ROPT_IMPLICIT 4
 
 regexp *regcomp();
 int regexec();
index b1b2202..73a3944 100644 (file)
@@ -1,8 +1,8 @@
 #!./perl
 
-# $Header: sort.t,v 4.0 91/03/20 01:54:38 lwall Locked $
+# $RCSfile: sort.t,v $$Revision: 4.0.1.1 $$Date: 91/11/05 18:43:47 $
 
-print "1..8\n";
+print "1..9\n";
 
 sub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; }
 
@@ -37,3 +37,7 @@ print ("@b" eq "3 2 1" ? "ok 7\n" : "not ok 7 (@b)\n");
 @a = (1,2,3,4);
 @b = reverse @a;
 print ("@b" eq "4 3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n");
+
+@a = (10,2,3,4);
+@b = sort {$a <=> $b;} @a;
+print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n");
index ffaefd1..a80a650 100644 (file)
@@ -6,9 +6,9 @@ See usersub.c.
 
 The sole purpose of the userinit() routine is to call the initialization
 routines for any modules that you want to link in.  In this example, we just
-call init_curses(), which sets up to link in the BSD curses routines.
+call init_curses(), which sets up to link in the System V curses routines.
 You'll find this in the file curses.c, which is the processed output of
-curses.mus.
+curses.mus.  (To get BSD curses, replace curses.mus with bsdcurses.mus.)
 
 The magicname() routine adds variable names into the symbol table.  Along
 with the name of the variable as Perl knows it, we pass a structure containing
@@ -96,15 +96,19 @@ to guess about input/output parameters, so you'll have to tidy up after it.
 But it can save you a lot of time if the man pages for a library are
 reasonably well formed.
 
-If you happen to have BSD curses on your machine, you might try compiling
+If you happen to have curses on your machine, you might try compiling
 a copy of curseperl.  The "pager" program in this directory is a rudimentary
 start on writing a pager--don't believe the help message, which is stolen
 from the less program.
 
-There is currently no official way to call a Perl routine back from C,
-but we're working on it.  It might be easiest to fake up a call to do_eval()
-or do_subr().  This is not for the faint of heart.  If you come up with
-such a glue routine, I'll be glad to add it into the distribution.
-
 User-defined subroutines may not currently be called as a signal handler,
 though a signal handler may itself call a user-defined subroutine.
+
+There are now glue routines to call back from C into Perl.  In usersub.c
+in this directory, you'll find callback() and callv().  The callback()
+routine presumes that any arguments to pass to the Perl subroutine
+have already been pushed onto the Perl stack.  The callv() routine
+is a wrapper that pushes an argv-style array of strings onto the
+stack for you, and then calls callback().  Be sure to recheck your
+stack pointer after returning from these routine, since the Perl code
+may have reallocated it.
index f8a686b..e406251 100644 (file)
@@ -1,4 +1,4 @@
-/* $RCSfile: util.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:20:43 $
+/* $RCSfile: util.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 19:21:20 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       util.h,v $
+ * Revision 4.0.1.2  91/11/05  19:21:20  lwall
+ * patch11: various portability fixes
+ * 
  * Revision 4.0.1.1  91/06/07  12:20:43  lwall
  * patch4: new copyright notice
  * 
@@ -16,6 +19,8 @@
 
 /* is the string for makedir a directory name or a filename? */
 
+#define fatal Myfatal
+
 #define MD_DIR 0
 #define MD_FILE 1
 
index f38968b..271581b 100644 (file)
@@ -1,4 +1,4 @@
-/* $RCSfile: walk.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:22:04 $
+/* $RCSfile: walk.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 19:25:09 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       walk.c,v $
+ * Revision 4.0.1.2  91/11/05  19:25:09  lwall
+ * patch11: in a2p, split on whitespace produced extra null field
+ * 
  * Revision 4.0.1.1  91/06/07  12:22:04  lwall
  * patch4: new copyright notice
  * patch4: a2p didn't correctly implement -n switch
@@ -30,6 +33,7 @@ bool saw_fh = FALSE;
 int maxtmp = 0;
 char *lparen;
 char *rparen;
+char *limit;
 STR *subs;
 STR *curargs = Nullstr;
 
@@ -670,6 +674,7 @@ sub Pick {\n\
        break;
     case OSPLIT:
        str = str_new(0);
+       limit = ", 9999)";
        numeric = 1;
        tmpstr = walk(1,level,ops[node+2].ival,&numarg,P_MIN);
        if (useval)
@@ -700,12 +705,14 @@ sub Pick {\n\
        }
        else if (saw_FS)
            str_cat(str,"$FS");
-       else
+       else {
            str_cat(str,"' '");
+           limit = ")";
+       }
        str_cat(str,", ");
        str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_COMMA+1));
        str_free(fstr);
-       str_cat(str,", 9999)");
+       str_cat(str,limit);
        if (useval) {
            str_cat(str,")");
        }