See patch #38.
#!/usr/bin/perl
# This assumes your /etc/utmp file looks like ours
-open(utmp,'/etc/utmp');
-@mo = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
-while (read(utmp,$utmp,36)) {
+open(UTMP,'/etc/utmp');
+@mo = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
+while (read(UTMP,$utmp,36)) {
($line,$name,$host,$time) = unpack('A8A8A16l',$utmp);
if ($name) {
$host = "($host)" if $host;
package DB;
-$header = '$Header: perldb.pl,v 3.0.1.4 90/10/15 17:40:38 lwall Locked $';
+$header = '$Header: perldb.pl,v 3.0.1.5 90/11/10 01:40:26 lwall Locked $';
#
# This file is automatically included if you do perl -d.
# It's probably not useful to include this yourself.
# have a breakpoint. It also inserts a do 'perldb.pl' before the first line.
#
# $Log: perldb.pl,v $
+# Revision 3.0.1.5 90/11/10 01:40:26 lwall
+# patch38: the debugger wouldn't stop correctly or do action routines
+#
# Revision 3.0.1.4 90/10/15 17:40:38 lwall
# patch29: added caller
# patch29: the debugger now understands packages and evals
$signal |= 1;
}
else {
- $signal |= &eval($stop);
+ &eval("\$DB'signal |= do {$stop;}");
$dbline{$line} =~ s/;9($|\0)/$1/;
}
}
print OUT "Line $i may not have an action.\n";
} else {
$dbline{$i} =~ s/\0[^\0]*//;
- $dbline .= "\0" . do action($3);
+ $dbline{$i} .= "\0" . do action($3);
}
next; };
$cmd =~ /^n$/ && do {
# syslog.pl
#
# $Log: syslog.pl,v $
-Revision 3.0.1.3 90/10/15 17:42:18 lwall
-patch29: various portability fixes
-
+# Revision 3.0.1.4 90/11/10 01:41:11 lwall
+# patch38: syslog.pl was referencing an absolute path
+#
+# Revision 3.0.1.3 90/10/15 17:42:18 lwall
+# patch29: various portability fixes
+#
# Revision 3.0.1.1 90/08/09 03:57:17 lwall
# patch19: Initial revision
#
$host = 'localhost' unless $host; # set $syslog'host to change
-require '/usr/local/lib/perl/syslog.ph';
+require 'syslog.ph';
$maskpri = &LOG_UPTO(&LOG_DEBUG);
--- /dev/null
+*** lib/perldb.pl Tue Oct 23 23:14:20 1990
+--- os2/perldb.pl Tue Nov 06 21:13:42 1990
+***************
+*** 36,43 ****
+ #
+ #
+
+! open(IN, "</dev/tty") || open(IN, "<&STDIN"); # so we don't dingle stdin
+! open(OUT,">/dev/tty") || open(OUT, ">&STDOUT"); # so we don't dongle stdout
+ select(OUT);
+ $| = 1; # for DB'OUT
+ select(STDOUT);
+--- 36,43 ----
+ #
+ #
+
+! open(IN, "<con") || open(IN, "<&STDIN"); # so we don't dingle stdin
+! open(OUT,">con") || open(OUT, ">&STDOUT"); # so we don't dongle stdout
+ select(OUT);
+ $| = 1; # for DB'OUT
+ select(STDOUT);
+***************
+*** 517,530 ****
+ s/(.*)/'$1'/ unless /^-?[\d.]+$/;
+ }
+
+! if (-f '.perldb') {
+! do './.perldb';
+ }
+! elsif (-f "$ENV{'LOGDIR'}/.perldb") {
+! do "$ENV{'LOGDIR'}/.perldb";
+ }
+! elsif (-f "$ENV{'HOME'}/.perldb") {
+! do "$ENV{'HOME'}/.perldb";
+ }
+
+ 1;
+--- 517,530 ----
+ s/(.*)/'$1'/ unless /^-?[\d.]+$/;
+ }
+
+! if (-f 'perldb.ini') {
+! do './perldb.ini';
+ }
+! elsif (-f "$ENV{'INIT'}/perldb.ini") {
+! do "$ENV{'INIT'}/perldb.ini";
+ }
+! elsif (-f "$ENV{'HOME'}/perldb.ini") {
+! do "$ENV{'HOME'}/perldb.ini";
+ }
+
+ 1;
-glob.c
+msdos\glob.c
setargv.obj
-perlglob.def
+os2\perlglob.def
perlglob.exe
-AS -LB -S0x1000
NAME PERLGLOB WINDOWCOMPAT NEWFILES
DESCRIPTION 'Filename globbing for PERL - for MS-DOS and OS/2'
-STUB 'REALGLOB.EXE'
-#define PATCHLEVEL 39
+#define PATCHLEVEL 40
''' Beginning of part 3
-''' $Header: perl_man.3,v 3.0.1.10 90/10/20 02:15:17 lwall Locked $
+''' $Header: perl_man.3,v 3.0.1.11 90/11/10 01:48:21 lwall Locked $
'''
''' $Log: perl.man.3,v $
+''' Revision 3.0.1.11 90/11/10 01:48:21 lwall
+''' patch38: random cleanup
+''' patch38: documented tr///cds
+'''
''' Revision 3.0.1.10 90/10/20 02:15:17 lwall
''' patch37: patch37: fixed various typos in man page
'''
count,
padding with nulls or spaces as necessary.
(When unpacking, "A" strips trailing spaces and nulls, but "a" does not.)
-Real numbers (floats and doubles) are in the nnativeative machine format
+Real numbers (floats and doubles) are in the native machine format
only; due to the multiplicity of floating formats around, and the lack
of a standard \*(L"network\*(R" representation, no facility for
interchange has been made.
representation is not part of the IEEE spec).
Note that perl uses
doubles internally for all numeric calculation, and converting from
-double -> float -> double will loose precision (i.e. unpack("f",
+double -> float -> double will lose precision (i.e. unpack("f",
pack("f", $foo)) will not in general equal $foo).
.br
Examples:
of its expressions evaluated in an array context.
Also be careful not to follow the print keyword with a left parenthesis
unless you want the corresponding right parenthesis to terminate the
-arguments to the print--interpose a + or put parens around all the arguments.
+arguments to the print\*(--interpose a + or put parens around all the arguments.
.Ip "printf(FILEHANDLE LIST)" 8 10
.Ip "printf(LIST)" 8
.Ip "printf FILEHANDLE LIST" 8
Returns 1 upon success, 0 otherwise.
.Ip "seekdir(DIRHANDLE,POS)" 8 3
Sets the current position for the readdir() routine on DIRHANDLE.
-POS must be a value returned by seekdir().
+POS must be a value returned by telldir().
Has the same caveats about possible directory compaction as the corresponding
system library routine.
.Ip "select(FILEHANDLE)" 8 3
Opens a socket of the specified kind and attaches it to filehandle SOCKET.
DOMAIN, TYPE and PROTOCOL are specified the same as for the system call
of the same name.
-You may need to run makelib on sys/socket.h to get the proper values handy
+You may need to run h2ph on sys/socket.h to get the proper values handy
in a perl library file.
Return true if successful.
See the example in the section on Interprocess Communication.
like numbers.
.nf
- require 'syscall.ph'; # may need to run makelib
+ require 'syscall.ph'; # may need to run h2ph
syscall(&SYS_write, fileno(STDOUT), "hi there\en", 9);
.fi
Has the same caveats about possible directory compaction as the corresponding
system library routine.
.Ip "time" 8 4
-Returns the number of non-leap seconds since January 1, 1970, UTC.
+Returns the number of non-leap seconds since 00:00:00 UTC, January 1, 1970.
Suitable for feeding to gmtime() and localtime().
.Ip "times" 8 4
Returns a four-element array giving the user and system times, in seconds, for this
.Sp
($user,$system,$cuser,$csystem) = times;
.Sp
-.Ip "tr/SEARCHLIST/REPLACEMENTLIST/" 8 5
-.Ip "y/SEARCHLIST/REPLACEMENTLIST/" 8
+.Ip "tr/SEARCHLIST/REPLACEMENTLIST/cds" 8 5
+.Ip "y/SEARCHLIST/REPLACEMENTLIST/cds" 8
Translates all occurrences of the characters found in the search list with
the corresponding character in the replacement list.
-It returns the number of characters replaced.
+It returns the number of characters replaced or deleted.
If no string is specified via the =~ or !~ operator,
the $_ string is translated.
(The string specified with =~ must be a scalar variable, an array element,
.I y
is provided as a synonym for
.IR tr .
+.Sp
+If the c modifier is specified, the SEARCHLIST character set is complemented.
+If the d modifier is specified, any characters specified by SEARCHLIST that
+are not found in REPLACEMENTLIST are deleted.
+(Note that this is slightly more flexible than the behavior of some
+.I tr
+programs, which delete anything they find in the SEARCHLIST, period.)
+If the s modifier is specified, sequences of characters that were translated
+to the same character are squashed down to 1 instance of the character.
+.Sp
+If the d modifier was used, the REPLACEMENTLIST is always interpreted exactly
+as specified.
+Otherwise, if the REPLACEMENTLIST is shorter than the SEARCHLIST,
+the final character is replicated till it is long enough.
+If the REPLACEMENTLIST is null, the SEARCHLIST is replicated.
+This latter is useful for counting characters in a class, or for squashing
+character sequences in a class.
+.Sp
Examples:
.nf
$cnt = tr/*/*/; \h'|3i'# count the stars in $_
+ $cnt = tr/0\-9//; \h'|3i'# count the digits in $_
+
+ tr/a\-zA\-Z//s; \h'|3i'# bookkeeper \-> bokeper
+
($HOST = $host) =~ tr/a\-z/A\-Z/;
- y/\e001\-@[\-_{\-\e177/ /; \h'|3i'# change non-alphas to space
+ y/a\-zA\-Z/ /cs; \h'|3i'# change non-alphas to single space
+
+ tr/\e200\-\e377/\e0\-\e177/;\h'|3i'# delete 8th bit
.fi
.Ip "truncate(FILEHANDLE,LENGTH)" 8 4
''' Beginning of part 4
-''' $Header: perl_man.4,v 3.0.1.12 90/10/20 02:15:43 lwall Locked $
+''' $Header: perl_man.4,v 3.0.1.13 90/11/10 01:51:00 lwall Locked $
'''
''' $Log: perl.man.4,v $
+''' Revision 3.0.1.13 90/11/10 01:51:00 lwall
+''' patch38: random cleanup
+'''
''' Revision 3.0.1.12 90/10/20 02:15:43 lwall
''' patch37: patch37: fixed various typos in man page
'''
left\h'|1i'&&
left\h'|1i'| ^
left\h'|1i'&
-nonassoc\h'|1i'== != eq ne
+nonassoc\h'|1i'== != <=> eq ne cmp
nonassoc\h'|1i'< > <= >= lt gt le ge
nonassoc\h'|1i'chdir exit eval reset sleep rand umask
nonassoc\h'|1i'\-r \-w \-x etc.
do foo(); # pass a null list
&foo(); # the same
- &foo; # pass no arguments--more efficient
+ &foo; # pass no arguments\*(--more efficient
.fi
.Sh "Passing By Reference"
results when $* is 0.
Default is 0.
(Mnemonic: * matches multiple things.)
+Note that this variable only influences the interpretation of ^ and $.
+A literal newline can be searched for even when $* == 0.
.Ip $0 8
Contains the name of the file containing the
.I perl
But don't put
- @foo{$a,$b,$c} # a slice--note the @
+ @foo{$a,$b,$c} # a slice\*(--note the @
which means
.fi
When in doubt, parenthesize.
At the very least it will let some poor schmuck bounce on the % key in vi.
+.Sp
+Even if you aren't in doubt, consider the mental welfare of the person who
+has to maintain the code after you, and who will probably put parens in
+the wrong place.
.Ip 2. 4 4
Don't go through silly contortions to exit a loop at the top or the
bottom, when
-char rcsid[] = "$Header: perly.c,v 3.0.1.8 90/10/16 10:14:20 lwall Locked $\nPatch level: ###\n";
+char rcsid[] = "$Header: perly.c,v 3.0.1.9 90/11/10 01:53:26 lwall Locked $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perly.c,v $
+ * Revision 3.0.1.9 90/11/10 01:53:26 lwall
+ * patch38: random cleanup
+ * patch38: more msdos/os2 upgrades
+ * patch38: references to $0 produced core dumps
+ * patch38: added hooks for unexec()
+ *
* Revision 3.0.1.8 90/10/16 10:14:20 lwall
* patch29: *foo now prints as *package'foo
* patch29: added waitpid
/* open script */
if (argv[0] == Nullch)
+#ifdef MSDOS
+ {
+ if ( isatty(fileno(stdin)) )
+ moreswitches("v");
+ argv[0] = "-";
+ }
+#else
argv[0] = "-";
+#endif
if (dosearch && !index(argv[0], '/') && (s = getenv("PATH"))) {
char *xfound = Nullch, *xfailed = Nullch;
int len;
#endif
(doextract ? "-e '1,/^#/d\n'" : ""),
argv[0], CPPSTDIN, str_get(str), CPPMINUS);
- doextract = FALSE;
+#ifdef DEBUGGING
+ if (debug & 64) {
+ fputs(buf,stderr);
+ fputs("\n",stderr);
+ }
+#endif
+ doextract = FALSE;
#ifdef IAMSUID /* actually, this is caught earlier */
if (euid != uid && !euid) /* if running suidperl */
#ifdef SETEUID
(void)hadd(sigstab);
}
- magicalize("!#?^~=-%0123456789.+&*()<>,\\/[|`':\024");
+ magicalize("!#?^~=-%123456789.+&*()<>,\\/[|`':\024");
userinit(); /* in case linked C routines want magical variables */
amperstab = stabent("&",allstabs);
statname = Str_new(66,0); /* last filename we did stat on */
if (do_undump)
- abort();
+ my_unexec();
just_doit: /* come here if running an undumped a.out */
argc--,argv++; /* skip name of script */
tainted = 1;
#endif
if (tmpstab = stabent("0",allstabs))
- str_set(STAB_STR(tmpstab),origfilename);
+ str_set(stab_val(tmpstab),origfilename);
if (argvstab = stabent("ARGV",allstabs)) {
argvstab->str_pok |= SP_MULTI;
(void)aadd(argvstab);
}
return Nullch;
}
+
+/* compliments of Tom Christiansen */
+
+/* unexec() can be found in the Gnu emacs distribution */
+
+my_unexec()
+{
+#ifdef UNEXEC
+ int status;
+ extern int etext;
+ static char dumpname[BUFSIZ];
+ static char perlpath[256];
+
+ sprintf (dumpname, "%s.perldump", origfilename);
+ sprintf (perlpath, "%s/perl", BIN);
+
+ status = unexec(dumpname, perlpath, &etext, sbrk(0), 0);
+ if (status)
+ fprintf(stderr, "unexec of %s into %s failed!\n", perlpath, dumpname);
+ exit(status);
+#else
+ abort(); /* for use with undump */
+#endif
+}
+
* blame Henry for some of the lack of readability.
*/
-/* $Header: regcomp.c,v 3.0.1.7 90/10/20 02:18:32 lwall Locked $
+/* $Header: regcomp.c,v 3.0.1.8 90/11/10 01:57:46 lwall Locked $
*
* $Log: regcomp.c,v $
+ * Revision 3.0.1.8 90/11/10 01:57:46 lwall
+ * patch38: patterns with multiple constant strings occasionally malfed
+ * patch38: patterns like /foo.*foo/ sped up some
+ *
* Revision 3.0.1.7 90/10/20 02:18:32 lwall
* patch37: /foo.*bar$/ wrongly optimized to do tail matching on "foo"
*
register int len;
register char *first;
int flags;
- int back;
+ int backish;
+ int backest;
int curback;
extern char *safemalloc();
extern char *savestr();
longest = str_make("",0);
len = 0;
curback = 0;
- back = 0;
+ backish = 0;
+ backest = 0;
while (OP(scan) != END) {
if (OP(scan) == BRANCH) {
if (OP(regnext(scan)) == BRANCH) {
first = scan;
while (OP(regnext(scan)) >= CLOSE)
scan = regnext(scan);
- if (curback - back == len) {
+ if (curback - backish == len) {
str_ncat(longish, OPERAND(first)+1,
*OPERAND(first));
len += *OPERAND(first);
else if (*OPERAND(first) >= len + (curback >= 0)) {
len = *OPERAND(first);
str_nset(longish, OPERAND(first)+1,len);
- back = curback;
+ backish = curback;
curback += len;
first = regnext(scan);
}
else if (index(varies,OP(scan))) {
curback = -30000;
len = 0;
- if (longish->str_cur > longest->str_cur)
+ if (longish->str_cur > longest->str_cur) {
str_sset(longest,longish);
+ backest = backish;
+ }
str_nset(longish,"",0);
}
else if (index(simple,OP(scan))) {
curback++;
len = 0;
- if (longish->str_cur > longest->str_cur)
+ if (longish->str_cur > longest->str_cur) {
str_sset(longest,longish);
+ backest = backish;
+ }
str_nset(longish,"",0);
}
scan = regnext(scan);
/* Prefer earlier on tie, unless we can tail match latter */
- if (longish->str_cur + (OP(first) == EOL) > longest->str_cur)
+ if (longish->str_cur + (OP(first) == EOL) > longest->str_cur) {
str_sset(longest,longish);
+ backest = backish;
+ }
else
str_nset(longish,"",0);
- if (longest->str_cur) {
+ if (longest->str_cur
+ &&
+ (!r->regstart
+ ||
+ !fbminstr(r->regstart->str_ptr,
+ r->regstart->str_ptr + r->regstart->str_cur,
+ longest)
+ )
+ )
+ {
r->regmust = longest;
- if (back < 0)
- back = -1;
- r->regback = back;
+ if (backest < 0)
+ backest = -1;
+ r->regback = backest;
if (longest->str_cur
> !(sawstudy || fold || OP(first) == EOL) )
fbmcompile(r->regmust,fold);
-/* $Header: regcomp.h,v 3.0.1.1 90/08/09 05:06:49 lwall Locked $
+/* $Header: regcomp.h,v 3.0.1.2 90/11/10 01:58:28 lwall Locked $
*
* $Log: regcomp.h,v $
+ * Revision 3.0.1.2 90/11/10 01:58:28 lwall
+ * patch38: random cleanup
+ *
* Revision 3.0.1.1 90/08/09 05:06:49 lwall
* patch19: sped up {m,n} on simple items
*
#ifndef gould
#ifndef cray
+#ifndef eta10
#define REGALIGN
#endif
#endif
+#endif
#define OP(p) (*(p))
* blame Henry for some of the lack of readability.
*/
-/* $Header: regexec.c,v 3.0.1.5 90/10/16 10:25:36 lwall Locked $
+/* $Header: regexec.c,v 3.0.1.6 90/11/10 02:00:57 lwall Locked $
*
* $Log: regexec.c,v $
+ * Revision 3.0.1.6 90/11/10 02:00:57 lwall
+ * patch38: patterns like /^foo.*bar/ sped up some
+ * patch38: /[^whatever]+/ could scan past end of string
+ *
* Revision 3.0.1.5 90/10/16 10:25:36 lwall
* patch29: /^pat/ occasionally matched in middle of string when $* = 0
* patch29: /.{n,m}$/ could match with fewer than n characters remaining
/* If there is a "must appear" string, look for it. */
s = string;
- if (prog->regmust != Nullstr) {
+ if (prog->regmust != Nullstr &&
+ (!(prog->reganch & 1) || (multiline && prog->regback >= 0)) ) {
if (stringarg == strbeg && screamer) {
if (screamfirst[prog->regmust->str_rare] >= 0)
s = screaminstr(screamer,prog->regmust);
nextchar = UCHARAT(locinput);
if (s[nextchar >> 3] & (1 << (nextchar&7)))
return(0);
- nextchar = *++locinput;
- if (!nextchar && locinput > regeol)
+ if (!nextchar && locinput >= regeol)
return 0;
+ nextchar = *++locinput;
break;
case ALNUM:
if (!nextchar)
-/* $Header: stab.c,v 3.0.1.9 90/10/16 10:32:05 lwall Locked $
+/* $Header: stab.c,v 3.0.1.10 90/11/10 02:02:05 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: stab.c,v $
+ * Revision 3.0.1.10 90/11/10 02:02:05 lwall
+ * patch38: random cleanup
+ *
* Revision 3.0.1.9 90/10/16 10:32:05 lwall
* patch29: added -M, -A and -C
* patch29: taintperl now checks for world writable PATH components
#define handlertype int
#endif
+static handlertype sighandler();
+
STR *
stab_str(str)
STR *str;
STAB *stab = mstr->str_u.str_stab;
char *s;
int i;
- static handlertype sighandler();
switch (mstr->str_rare) {
case 'E':
CMD *cmd;
i = str_true(str);
- str = afetch(stab_xarray(stab),atoi(mstr->str_ptr));
+ str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE);
cmd = str->str_magic->str_u.str_cmd;
cmd->c_flags &= ~CF_OPTIMIZE;
cmd->c_flags |= i? CFT_D1 : CFT_D0;
-/* $Header: str.c,v 3.0.1.9 90/10/16 10:41:21 lwall Locked $
+/* $Header: str.c,v 3.0.1.10 90/11/10 02:06:29 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.c,v $
+ * Revision 3.0.1.10 90/11/10 02:06:29 lwall
+ * patch38: temp string values are now copied less often
+ * patch38: array slurps are now faster and take less memory
+ * patch38: fixed a memory leakage on local(*foo)
+ *
* Revision 3.0.1.9 90/10/16 10:41:21 lwall
* patch29: the undefined value could get defined by devious means
* patch29: undefined values compared inconsistently
return str->str_u.str_nval;
}
+/* Note: str_sset() should not be called with a source string that needs
+ * be reused, since it may destroy the source string if it is marked
+ * as temporary.
+ */
+
str_sset(dstr,sstr)
STR *dstr;
register STR *sstr;
if (!sstr)
dstr->str_pok = dstr->str_nok = 0;
else if (sstr->str_pok) {
- str_nset(dstr,sstr->str_ptr,sstr->str_cur);
- if (sstr->str_nok) {
- dstr->str_u.str_nval = sstr->str_u.str_nval;
- dstr->str_nok = 1;
- dstr->str_state = SS_NORM;
+
+ /*
+ * Check to see if we can just swipe the string. If so, it's a
+ * possible small lose on short strings, but a big win on long ones.
+ */
+
+ if (sstr->str_pok & SP_TEMP) { /* slated for free anyway? */
+ if (dstr->str_ptr)
+ Safefree(dstr->str_ptr);
+#ifdef STRUCTCOPY
+ *dstr = *sstr;
+#else
+ Copy(sstr, dstr, 1, STR);
+#endif
+ Zero(sstr, 1, STR); /* (probably overkill) */
+ dstr->str_pok &= ~SP_TEMP;
}
- else if (sstr->str_cur == sizeof(STBP)) {
- char *tmps = sstr->str_ptr;
+ else { /* have to copy piecemeal */
+ str_nset(dstr,sstr->str_ptr,sstr->str_cur);
+ if (sstr->str_nok) {
+ dstr->str_u.str_nval = sstr->str_u.str_nval;
+ dstr->str_nok = 1;
+ dstr->str_state = SS_NORM;
+ }
+ else if (sstr->str_cur == sizeof(STBP)) {
+ char *tmps = sstr->str_ptr;
- if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
- if (!dstr->str_magic) {
- dstr->str_magic = str_smake(sstr->str_magic);
- dstr->str_magic->str_rare = 'X';
+ if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
+ if (!dstr->str_magic) {
+ dstr->str_magic = str_smake(sstr->str_magic);
+ dstr->str_magic->str_rare = 'X';
+ }
}
}
}
#ifdef TAINT
str->str_tainted = nstr->str_tainted;
#endif
+ if (nstr->str_magic)
+ str_free(nstr->str_magic);
Safefree(nstr);
}
STRLEN obpx;
register int get_paragraph;
register char *oldbp;
+ int shortbuffered;
if (str == &str_undef)
return Nullch;
cnt = fp->_cnt; /* get count into register */
str->str_nok = 0; /* invalidate number */
str->str_pok = 1; /* validate pointer */
- if (str->str_len <= cnt + 1) /* make sure we have the room */
- STR_GROW(str, append+cnt+2); /* (remembering cnt can be -1) */
+ if (str->str_len <= cnt + 1) { /* make sure we have the room */
+ if (cnt > 80 && str->str_len > 0) {
+ shortbuffered = cnt - str->str_len;
+ cnt = str->str_len;
+ }
+ else {
+ shortbuffered = 0;
+ STR_GROW(str, append+cnt+2);/* (remembering cnt can be -1) */
+ }
+ }
+ else
+ shortbuffered = 0;
bp = str->str_ptr + append; /* move these two too to registers */
ptr = fp->_ptr;
for (;;) {
goto thats_all_folks; /* screams */ /* sed :-) */
}
+ if (shortbuffered) { /* oh well, must extend */
+ cnt = shortbuffered;
+ shortbuffered = 0;
+ if (get_paragraph && oldbp)
+ obpx = oldbp - str->str_ptr;
+ bpx = bp - str->str_ptr; /* prepare for possible relocation */
+ STR_GROW(str, str->str_len + append + cnt + 2);
+ bp = str->str_ptr + bpx; /* reconstitute our pointer */
+ if (get_paragraph && oldbp)
+ oldbp = str->str_ptr + obpx;
+ continue;
+ }
+
fp->_cnt = cnt; /* deregisterize cnt and ptr */
fp->_ptr = ptr;
i = _filbuf(fp); /* get more characters */
goto screamer; /* and go back to the fray */
}
thats_really_all_folks:
+ if (shortbuffered)
+ cnt += shortbuffered;
fp->_cnt = cnt; /* put these back or we're in trouble */
fp->_ptr = ptr;
*bp = '\0';
}
}
tmps_list[tmps_max] = str;
+ if (str->str_pok)
+ str->str_pok |= SP_TEMP;
return str;
}
}
}
tmps_list[tmps_max] = str;
+ if (str->str_pok)
+ str->str_pok |= SP_TEMP;
return str;
}
-/* $Header: str.h,v 3.0.1.3 90/10/16 10:44:04 lwall Locked $
+/* $Header: str.h,v 3.0.1.4 90/11/10 02:07:52 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.h,v $
+ * Revision 3.0.1.4 90/11/10 02:07:52 lwall
+ * patch38: temp string values are now copied less often
+ *
* Revision 3.0.1.3 90/10/16 10:44:04 lwall
* patch29: added caller
* patch29: scripts now run at almost full speed under the debugger
#define SP_INTRP 16 /* string was compiled for interping */
#define SP_TAIL 32 /* fbm string is tail anchored: /foo$/ */
#define SP_MULTI 64 /* symbol table entry probably isn't a typo */
+#define SP_TEMP 128 /* string slated to die, so can be plundered */
#define Nullstr Null(STR*)
-/* $Header: toke.c,v 3.0.1.10 90/10/16 11:20:46 lwall Locked $
+/* $Header: toke.c,v 3.0.1.11 90/11/10 02:13:44 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: toke.c,v $
+ * Revision 3.0.1.11 90/11/10 02:13:44 lwall
+ * patch38: added alarm function
+ * patch38: tr was busted in metacharacters on signed char machines
+ *
* Revision 3.0.1.10 90/10/16 11:20:46 lwall
* patch29: the length of a search pattern was limited
* patch29: added DATA filehandle to read stuff after __END__
break;
case 'a': case 'A':
SNARFWORD;
+ if (strEQ(d,"alarm"))
+ UNI(O_ALARM);
if (strEQ(d,"accept"))
FOP22(O_ACCEPT);
if (strEQ(d,"atan2"))
--j;
}
if (tbl[t[i] & 0377] == -1)
- tbl[t[i] & 0377] = r[j];
+ tbl[t[i] & 0377] = r[j] & 0377;
}
}
if (r != t)
-/* $Header: util.c,v 3.0.1.9 90/10/20 02:21:01 lwall Locked $
+/* $Header: util.c,v 3.0.1.10 90/11/10 02:19:28 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: util.c,v $
+ * Revision 3.0.1.10 90/11/10 02:19:28 lwall
+ * patch38: random cleanup
+ * patch38: sequence of s/^x//; s/x$//; could screw up malloc
+ *
* Revision 3.0.1.9 90/10/20 02:21:01 lwall
* patch37: tried to take strlen of integer on systems without wait4 or waitpid
* patch37: unreachable return eliminated
exit(1);
}
#endif /* MSDOS */
+#ifdef DEBUGGING
+ if ((long)size < 0)
+ fatal("panic: malloc");
+#endif
ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
#ifdef DEBUGGING
# ifndef I286
if (ptr != Nullch)
return ptr;
else {
- fputs(nomem,stdout) FLUSH;
+ fputs(nomem,stderr) FLUSH;
exit(1);
}
/*NOTREACHED*/
#endif /* MSDOS */
if (!where)
fatal("Null realloc");
+#ifdef DEBUGGING
+ if ((long)size < 0)
+ fatal("panic: realloc");
+#endif
ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
#ifdef DEBUGGING
# ifndef I286
if (ptr != Nullch)
return ptr;
else {
- fputs(nomem,stdout) FLUSH;
+ fputs(nomem,stderr) FLUSH;
exit(1);
}
/*NOTREACHED*/
s = bigend - littlelen;
if (*s == *little && bcmp(s,little,littlelen)==0)
return (char*)s; /* how sweet it is */
- else if (bigend[-1] == '\n' && little[littlelen-1] != '\n') {
+ else if (bigend[-1] == '\n' && little[littlelen-1] != '\n'
+ && s > big) {
s--;
if (*s == *little && bcmp(s,little,littlelen)==0)
return (char*)s;
if (flags)
fatal("Can't do waitpid with flags");
else {
- int result;
register int count;
register STR *str;
{
long along;
+#ifdef mips
+# define BIGDOUBLE 2147483648.0
+ if (f >= BIGDOUBLE)
+ return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
+#endif
if (f >= 0.0)
return (unsigned long)f;
along = (long)f;
projects / p5sagit/p5-mst-13.2.git / commitdiff