See patch #11.
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
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
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
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
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
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
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
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
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
-/* $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
*
* 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[];
"CLOSEDIR",
"SYSCALL",
"PIPE",
- "267"
+ "TRY",
+ "EVALONCE",
+ "269"
};
#endif
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
-/* $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
*
* 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
*
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;
}
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;
}
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;
if (!ar)
return;
+ /*SUPPRESS 560*/
if (key = ar->ary_array - ar->ary_alloc) {
ar->ary_max += key;
ar->ary_array -= key;
#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 */
-/* $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
*
* 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
#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;
#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;
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) {
}
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;
-/* $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
*
* 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
for (; fcmd; fcmd = nextfcmd) {
nextfcmd = fcmd->f_next;
CHKLEN(fcmd->f_presize);
+ /*SUPPRESS 560*/
if (s = fcmd->f_pre) {
while (*s) {
if (*s == '\n') {
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;
*d++ = '.';
size -= 3;
}
- while (*chophere && index(chopset,*chophere))
+ while (*chophere && index(chopset,*chophere)
+ && isSPACE(*chophere))
chophere++;
str_chop(str,chophere);
}
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;
chophere = s;
size += (s - chophere);
s = chophere;
- while (*chophere && index(chopset,*chophere))
+ while (*chophere && index(chopset,*chophere)
+ && isSPACE(*chophere))
chophere++;
}
tmpchar = *s;
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;
chophere = s;
size += (s - chophere);
s = chophere;
- while (*chophere && index(chopset,*chophere))
+ while (*chophere && index(chopset,*chophere)
+ && isSPACE(*chophere))
chophere++;
}
tmpchar = *s;
(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) {
'di';
'ig00';
-\$perlincl = '$privlib';
+\$perlincl = '$installprivlib';
!GROK!THIS!
: In the following dollars and backticks do not need the extra backslash.
FILE
END
-$isatype{@isatype} = (1) x @isatype;
+@isatype{@isatype} = (1) x @isatype;
@ARGV = ('-') unless @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;
}
}
}
- elsif (/^include <(.*)>/) {
+ elsif (/^include\s+<(.*)>/) {
($incl = $1) =~ s/\.h$/.ph/;
print OUT $t,"require '$incl';\n";
}
-/* $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
*
* 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. */
#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))))
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"
--- /dev/null
+ccflags="$ccflags -X18"
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{$_}; }
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;
}
;#
-;# @(#)complete.pl 1.0 (sun!waynet) 11/11/88
+;# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91
;#
;# Author: Wayne Thompson
;#
;# 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;
}
--- /dev/null
+# 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;
-;# $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
local($_,$first,$rest);
local($[) = 0;
- while (($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+ while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
($first,$rest) = ($1,$2);
if (index($argumentative,$first) >= $[) {
if ($rest ne '') {
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 >= $[) {
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
#
-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|' | \
-#define PATCHLEVEL 17
+#define PATCHLEVEL 18
* 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 $*
int backest;
int curback;
int minlen;
+#ifndef safemalloc
extern char *safemalloc();
+#endif
extern char *savestr();
int sawplus = 0;
int sawopen = 0;
* 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
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 */
#define ROPT_ANCH 1
#define ROPT_SKIP 2
+#define ROPT_IMPLICIT 4
regexp *regcomp();
int regexec();
#!./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; }
@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");
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
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.
-/* $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
*
* 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
*
/* is the string for makedir a directory name or a filename? */
+#define fatal Myfatal
+
#define MD_DIR 0
#define MD_FILE 1
-/* $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
*
* 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
int maxtmp = 0;
char *lparen;
char *rparen;
+char *limit;
STR *subs;
STR *curargs = Nullstr;
break;
case OSPLIT:
str = str_new(0);
+ limit = ", 9999)";
numeric = 1;
tmpstr = walk(1,level,ops[node+2].ival,&numarg,P_MIN);
if (useval)
}
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,")");
}
projects / p5sagit/p5-mst-13.2.git / commitdiff