From: Larry Wall Date: Tue, 5 Nov 1991 09:55:53 +0000 (+0000) Subject: perl 4.0 patch 18: patch #11, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=55204971972392ce5a252fbbd6d78b1c48ed70e3;p=p5sagit%2Fp5-mst-13.2.git perl 4.0 patch 18: patch #11, continued See patch #11. --- diff --git a/MANIFEST b/MANIFEST index 60d1ba2..ca59619 100644 --- 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 --- 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 @@ -283,7 +287,9 @@ #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 --- 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 --- 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 --- 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 --- a/h2ph.SH +++ b/h2ph.SH @@ -24,7 +24,7 @@ $spitshell >h2ph </) { + 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 --- 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 * @@ -52,6 +58,22 @@ #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)))) diff --git a/hints/aix_rs.sh b/hints/aix_rs.sh index 8f31a03..17b22a1 100644 --- a/hints/aix_rs.sh +++ b/hints/aix_rs.sh @@ -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 index 0000000..da6fcc9 --- /dev/null +++ b/hints/greenhills.sh @@ -0,0 +1 @@ +ccflags="$ccflags -X18" diff --git a/lib/cacheout.pl b/lib/cacheout.pl index 106014c..bec40bd 100644 --- a/lib/cacheout.pl +++ b/lib/cacheout.pl @@ -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 () { - $maxopen = $1 - 4 if /^#define NOFILE\s+(\d+)/; + $maxopen = $1 - 4 if /^\s*#\s*define\s+NOFILE\s+(\d+)/; } close PARAM; } diff --git a/lib/complete.pl b/lib/complete.pl index 73d3649..dabf8f6 100644 --- a/lib/complete.pl +++ b/lib/complete.pl @@ -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. @@ -18,78 +18,92 @@ ;# 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 index 0000000..114e890 --- /dev/null +++ b/lib/getcwd.pl @@ -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; diff --git a/lib/getopt.pl b/lib/getopt.pl index da39d3b..b9d7b5b 100644 --- a/lib/getopt.pl +++ b/lib/getopt.pl @@ -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 '') { diff --git a/lib/getopts.pl b/lib/getopts.pl index 4ed3a05..6590918 100644 --- a/lib/getopts.pl +++ b/lib/getopts.pl @@ -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 >= $[) { diff --git a/makedepend.SH b/makedepend.SH index 2f94175..8fb59cd 100644 --- a/makedepend.SH +++ b/makedepend.SH @@ -15,9 +15,12 @@ esac echo "Extracting makedepend (with variable substitutions)" $spitshell >makedepend < $b;} @a; +print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n"); diff --git a/usub/README b/usub/README index ffaefd1..a80a650 100644 --- a/usub/README +++ b/usub/README @@ -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. diff --git a/x2p/util.h b/x2p/util.h index f8a686b..e406251 100644 --- a/x2p/util.h +++ b/x2p/util.h @@ -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 diff --git a/x2p/walk.c b/x2p/walk.c index f38968b..271581b 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -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,")"); }