perl 3.0 patch #25
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Sat Aug 11 07:30:01 AEST 1990
System: perl version 3.0
Patch #: 25
Priority:
Subject: patch #19, continued
Description:
See patch #19.
Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source
directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After patching:
*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #27 FIRST ***
If patch indicates that patchlevel is the wrong version, you may need
to apply one or more previous patches, or the patch may already
have been applied. See the patchlevel.h file to find out what has or
has not been applied. In any event, don't continue with the patch.
If you are missing previous patches they can be obtained from me:
Larry Wall
lwall at jpl-devvax.jpl.nasa.gov
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 3.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU either in Internet notation,
or in bang notation from some well-known host, and LIST is the number
of one or more patches you need, separated by spaces, commas, and/or
hyphens. Saying 35- says everything from 35 to the end.
You can also get the patches via anonymous FTP from
jpl-devvax.jpl.nasa.gov (128.149.1.143).
Index: patchlevel.h
Prereq: 24
1c1
< #define PATCHLEVEL 24
---
> #define PATCHLEVEL 25
Index: msdos/popen.c
Prereq: 3.0.1.1
*** msdos/popen.c.old Thu Aug 9 06:01:38 1990
--- msdos/popen.c Thu Aug 9 06:01:39 1990
***************
*** 1,4 ****
! /* $Header: popen.c,v 3.0.1.1 90/03/27 16:11:57 lwall Locked $
*
* (C) Copyright 1988, 1990 Diomidis Spinellis.
*
--- 1,4 ----
! /* $Header: popen.c,v 3.0.1.2 90/08/09 04:04:42 lwall Locked $
*
* (C) Copyright 1988, 1990 Diomidis Spinellis.
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: popen.c,v $
+ * Revision 3.0.1.2 90/08/09 04:04:42 lwall
+ * patch19: various MSDOS and OS/2 patches folded in
+ *
* Revision 3.0.1.1 90/03/27 16:11:57 lwall
* patch16: MSDOS support
*
***************
*** 85,91 ****
switch (*t) {
case 'r':
! sprintf(buff, "%s >%s", command, name);
if (system(buff) || (f = fopen(name, "r")) == NULL) {
free(name);
return NULL;
--- 88,94 ----
switch (*t) {
case 'r':
! sprintf(buff, "%s>%s", command, name);
if (system(buff) || (f = fopen(name, "r")) == NULL) {
free(name);
return NULL;
Index: os2/popen.c
*** os2/popen.c.old Thu Aug 9 06:02:37 1990
--- os2/popen.c Thu Aug 9 06:02:40 1990
***************
*** 0 ****
--- 1,210 ----
+ /*
+ * Pipe support for OS/2.
+ *
+ * WARNING: I am guilty of chumminess with the runtime library because
+ * I had no choice. Details to follow.
+ *
+ */
+
+ #include "EXTERN.h"
+ #include "perl.h"
+ #define INCL_DOSPROCESS
+ #define INCL_DOSQUEUES
+ #define INCL_DOSMISC
+ #define INCL_DOSMEMMGR
+ #include <os2.h>
+
+ extern char **environ;
+
+ /* This mysterious array _osfile is used internally by the runtime
+ * library to remember assorted things about open file handles.
+ * The problem is that we are creating file handles via DosMakePipe,
+ * rather than via the runtime library. This means that we have
+ * to fake the runtime library into thinking that the handles we've
+ * created are honest file handles. So just before doing the fdopen,
+ * we poke in a magic value that fools the library functions into
+ * thinking that the handle is already open in text mode.
+ *
+ * This might not work for your compiler, so beware.
+ */
+ extern char _osfile[];
+
+ /* The maximum number of simultaneously open pipes. We create an
+ * array of this size to record information about each open pipe.
+ */
+ #define MAXPIPES 5
+
+ /* Information to remember about each open pipe.
+ * The (FILE *) that popen returns is stored because that's the only
+ * way we can keep track of the pipes.
+ */
+ typedef struct pipeinfo {
+ FILE *pfId; /* Which FILE we're talking about */
+ HFILE hfMe; /* handle I should close at pclose */
+ PID pidChild; /* Child's PID */
+ CHAR fReading; /* A read or write pipe? */
+ } PIPEINFO, *PPIPEINFO; /* pi and ppi */
+
+ static PIPEINFO PipeInfo[MAXPIPES];
+
+ FILE *mypopen(const char *command, const char *t)
+ {
+ typedef char *PSZZ;
+ PSZZ pszzPipeArgs = 0;
+ PSZZ pszzEnviron = 0;
+ PSZ *ppsz;
+ PSZ psz;
+ FILE *f;
+ HFILE hfMe, hfYou;
+ HFILE hf, hfSave;
+ RESULTCODES rc;
+ USHORT us;
+ PPIPEINFO ppi;
+ UINT i;
+
+ /* Validate pipe type */
+ if (*t != 'w' && *t != 'r') fatal("Unknown pipe type");
+
+ /* Room for another pipe? */
+ for (ppi = &PipeInfo[0]; ppi < &PipeInfo[MAXPIPES]; ppi++)
+ if (ppi->pfId == 0) goto foundone;
+ return NULL;
+
+ foundone:
+
+ /* Make the pipe */
+ if (DosMakePipe(&hfMe, &hfYou, 0)) return NULL;
+
+ /* Build the environment. First compute its length, then copy
+ * the environment strings into it.
+ */
+ i = 0;
+ for (ppsz = environ; *ppsz; ppsz++) i += 1 + strlen(*ppsz);
+ New(1204, pszzEnviron, 1+i, CHAR);
+
+ psz = pszzEnviron;
+ for (ppsz = environ; *ppsz; ppsz++) {
+ strcpy(psz, *ppsz);
+ psz += 1 + strlen(*ppsz);
+ }
+ *psz = 0;
+
+ /* Build the command string to execute.
+ * 6 = length(0 "/c " 0 0)
+ */
+ if (DosScanEnv("COMSPEC", &psz)) psz = "C:\\OS2\\cmd.exe";
+ #if 0
+ New(1203, pszzPipeArgs, strlen(psz) + strlen(command) + 6, CHAR);
+ #else
+ #define pszzPipeArgs buf
+ #endif
+ sprintf(pszzPipeArgs, "%s%c/c %s%c", psz, 0, command, 0);
+
+ /* Now some stuff that depends on what kind of pipe we're doing.
+ * We pull a sneaky trick; namely, that stdin = 0 = false,
+ * and stdout = 1 = true. The end result is that if the
+ * pipe is a read pipe, then hf = 1; if it's a write pipe, then
+ * hf = 0 and Me and You are reversed.
+ */
+ if (!(hf = (*t == 'r'))) {
+ /* The meaning of Me and You is reversed for write pipes. */
+ hfSave = hfYou; hfYou = hfMe; hfMe = hfSave;
+ }
+
+ ppi->fReading = hf;
+
+ /* Trick number 1: Fooling the runtime library into thinking
+ * that the file handle is legit.
+ *
+ * Trick number 2: Don't let my handle go over to the child!
+ * Since the child never closes it (why should it?), I'd better
+ * make sure he never sees it in the first place. Otherwise,
+ * we are in deadlock city.
+ */
+ _osfile[hfMe] = 0x81; /* Danger, Will Robinson! */
+ if (!(ppi->pfId = fdopen(hfMe, t))) goto no_fdopen;
+ DosSetFHandState(hfMe, OPEN_FLAGS_NOINHERIT);
+
+ /* Save the original handle because we're going to diddle it */
+ hfSave = 0xFFFF;
+ if (DosDupHandle(hf, &hfSave)) goto no_dup_init;
+
+ /* Force the child's handle onto the stdio handle */
+ if (DosDupHandle(hfYou, &hf)) goto no_force_dup;
+ DosClose(hfYou);
+
+ /* Now run the guy servicing the pipe */
+ us = DosExecPgm(NULL, 0, EXEC_ASYNCRESULT, pszzPipeArgs, pszzEnviron,
+ &rc, pszzPipeArgs);
+
+ /* Restore stdio handle, even if exec failed. */
+ DosDupHandle(hfSave, &hf); close(hfSave);
+
+ /* See if the exec succeeded. */
+ if (us) goto no_exec_pgm;
+
+ /* Remember the child's PID */
+ ppi->pidChild = rc.codeTerminate;
+
+ Safefree(pszzEnviron);
+
+ /* Phew. */
+ return ppi->pfId;
+
+ /* Here is where we clean up after an error. */
+ no_exec_pgm: ;
+ no_force_dup: close(hfSave);
+ no_dup_init: fclose(f);
+ no_fdopen:
+ DosClose(hfMe); DosClose(hfYou);
+ ppi->pfId = 0;
+ Safefree(pszzEnviron);
+ return NULL;
+ }
+
+
+ /* mypclose: Closes the pipe associated with the file handle.
+ * After waiting for the child process to terminate, its return
+ * code is returned. If the stream was not associated with a pipe,
+ * we return -1.
+ */
+ int
+ mypclose(FILE *f)
+ {
+ PPIPEINFO ppi;
+ RESULTCODES rc;
+ USHORT us;
+
+ /* Find the pipe this (FILE *) refers to */
+ for (ppi = &PipeInfo[0]; ppi < &PipeInfo[MAXPIPES]; ppi++)
+ if (ppi->pfId == f) goto foundit;
+ return -1;
+ foundit:
+ if (ppi->fReading && !DosRead(fileno(f), &rc, 1, &us) && us > 0) {
+ DosKillProcess(DKP_PROCESSTREE, ppi->pidChild);
+ }
+ fclose(f);
+ DosCwait(DCWA_PROCESS, DCWW_WAIT, &rc, &ppi->pidChild, ppi->pidChild);
+ ppi->pfId = 0;
+ return rc.codeResult;
+ }
+
+ /* pipe: The only tricky thing is letting the runtime library know about
+ * our two new file descriptors.
+ */
+ int pipe(int filedes[2])
+ {
+ HFILE hfRead, hfWrite;
+ USHORT usResult;
+
+ usResult = DosMakePipe(&hfRead, &hfWrite, 0);
+ if (usResult) {
+ /* Error 4 == ERROR_TOO_MANY_OPEN_FILES */
+ errno = (usResult == 4) ? ENFILE : ENOMEM;
+ return -1;
+ }
+ _osfile[hfRead] = _osfile[hfWrite] = 0x81;/* Danger, Will Robinson! */
+ filedes[0] = hfRead;
+ filedes[1] = hfWrite;
+ return 0;
+ }
Index: lib/pwd.pl
*** lib/pwd.pl.old Thu Aug 9 06:01:01 1990
--- lib/pwd.pl Thu Aug 9 06:01:03 1990
***************
*** 0 ****
--- 1,48 ----
+ ;# pwd.pl - keeps track of current working directory in PWD environment var
+ ;#
+ ;# $Header: pwd.pl,v 3.0.1.1 90/08/09 04:01:24 lwall Locked $
+ ;#
+ ;# $Log: pwd.pl,v $
+ ;# Revision 3.0.1.1 90/08/09 04:01:24 lwall
+ ;# patch19: Initial revision
+ ;#
+ ;#
+ ;# Usage:
+ ;# require "pwd.pl";
+ ;# &initpwd;
+ ;# ...
+ ;# &chdir($newdir);
+
+ package pwd;
+
+ sub main'initpwd {
+ if ($ENV{'PWD'}) {
+ local($dd,$di) = stat('.');
+ local($pd,$pi) = stat($ENV{'PWD'});
+ return if $di == $pi && $dd == $pd;
+ }
+ chop($ENV{'PWD'} = `pwd`);
+ }
+
+ sub main'chdir {
+ local($newdir) = shift;
+ if (chdir $newdir) {
+ if ($newdir =~ m#^/#) {
+ $ENV{'PWD'} = $newdir;
+ }
+ else {
+ local(@curdir) = split(m#/#,$ENV{'PWD'});
+ @curdir = '' unless @curdir;
+ foreach $component (split(m#/#, $newdir)) {
+ next if $component eq '.';
+ pop(@curdir),next if $component eq '..';
+ push(@curdir,$component);
+ }
+ $ENV{'PWD'} = join('/', at curdir) || '/';
+ }
+ }
+ else {
+ 0;
+ }
+ }
+
Index: regcomp.c
Prereq: 3.0.1.3
*** regcomp.c.old Thu Aug 9 06:04:48 1990
--- regcomp.c Thu Aug 9 06:04:51 1990
***************
*** 7,15 ****
* blame Henry for some of the lack of readability.
*/
! /* $Header: regcomp.c,v 3.0.1.3 90/03/12 16:59:22 lwall Locked $
*
* $Log: regcomp.c,v $
* Revision 3.0.1.3 90/03/12 16:59:22 lwall
* patch13: pattern matches can now use \0 to mean \000
*
--- 7,22 ----
* blame Henry for some of the lack of readability.
*/
! /* $Header: regcomp.c,v 3.0.1.4 90/08/09 05:05:33 lwall Locked $
*
* $Log: regcomp.c,v $
+ * Revision 3.0.1.4 90/08/09 05:05:33 lwall
+ * patch19: sped up /x+y/ patterns greatly by not retrying on every x
+ * patch19: inhibited backoff on patterns anchored to the end like /\s+$/
+ * patch19: sped up {m,n} on simple items
+ * patch19: optimized /.*whatever/ to /^.*whatever/
+ * patch19: fixed character classes to allow backslashing hyphen
+ *
* Revision 3.0.1.3 90/03/12 16:59:22 lwall
* patch13: pattern matches can now use \0 to mean \000
*
***************
*** 121,131 ****
* of the structure of the compiled regexp. [I'll say.]
*/
regexp *
! regcomp(exp,xend,fold,rare)
char *exp;
char *xend;
int fold;
- int rare;
{
register regexp *r;
register char *scan;
--- 128,137 ----
* of the structure of the compiled regexp. [I'll say.]
*/
regexp *
! regcomp(exp,xend,fold)
char *exp;
char *xend;
int fold;
{
register regexp *r;
register char *scan;
***************
*** 137,142 ****
--- 143,149 ----
int curback;
extern char *safemalloc();
extern char *savestr();
+ int sawplus = 0;
if (exp == NULL)
fatal("NULL regexp argument");
***************
*** 190,197 ****
first = scan;
while ((OP(first) > OPEN && OP(first) < CLOSE) ||
(OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
! (OP(first) == PLUS) )
first = NEXTOPER(first);
/* Starting-point info. */
if (OP(first) == EXACTLY) {
--- 197,210 ----
first = scan;
while ((OP(first) > OPEN && OP(first) < CLOSE) ||
(OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
! (OP(first) == PLUS) ||
! (OP(first) == CURLY && ARG1(first) > 0) ) {
! if (OP(first) == CURLY)
! first += 4;
! else if (OP(first) == PLUS)
! sawplus = 2;
first = NEXTOPER(first);
+ }
/* Starting-point info. */
if (OP(first) == EXACTLY) {
***************
*** 204,211 ****
r->regstclass = first;
else if (OP(first) == BOUND || OP(first) == NBOUND)
r->regstclass = first;
! else if (OP(first) == BOL)
! r->reganch++;
#ifdef DEBUGGING
if (debug & 512)
--- 217,226 ----
r->regstclass = first;
else if (OP(first) == BOUND || OP(first) == NBOUND)
r->regstclass = first;
! else if (OP(first) == BOL ||
! (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) )
! r->reganch = 1; /* kinda turn .* into ^.* */
! r->reganch |= sawplus;
#ifdef DEBUGGING
if (debug & 512)
***************
*** 449,469 ****
next++;
}
if (*next == '}') { /* got one */
- regsawbracket++; /* remember we clobbered exp */
if (!max)
max = next;
regparse++;
iter = atoi(regparse);
if (iter > 0) {
ch = *max;
sprintf(regparse,"%.*d", max-regparse, iter - 1);
*max = ch;
! if (*max == ',' && atoi(max+1) > 0) {
ch = *next;
sprintf(max+1,"%.*d", next-(max+1), atoi(max+1) - 1);
*next = ch;
}
! if (iter != 1 || (*max == ',' || atoi(max+1))) {
regparse = origparse; /* back up input pointer */
regnpar = orignpar; /* don't make more parens */
}
--- 464,507 ----
next++;
}
if (*next == '}') { /* got one */
if (!max)
max = next;
regparse++;
iter = atoi(regparse);
+ if (flags&SIMPLE) { /* we can do it right after all */
+ int tmp;
+
+ reginsert(CURLY, ret);
+ if (*max == ',')
+ max++;
+ tmp = atoi(max);
+ if (tmp && tmp < iter)
+ fatal("Can't do {n,m} with n > m");
+ if (regcode != ®dummy) {
+ #ifdef REGALIGN
+ *(unsigned short *)(ret+3) = iter;
+ *(unsigned short *)(ret+5) = tmp;
+ #else
+ ret[3] = iter >> 8; ret[4] = iter & 0377;
+ ret[5] = tmp >> 8; ret[6] = tmp & 0377;
+ #endif
+ }
+ regparse = next;
+ goto nest_check;
+ }
+ regsawbracket++; /* remember we clobbered exp */
if (iter > 0) {
ch = *max;
sprintf(regparse,"%.*d", max-regparse, iter - 1);
*max = ch;
! if (*max == ',' && max[1] != '}') {
! if (atoi(max+1) <= 0)
! fatal("Can't do {n,m} with n > m");
ch = *next;
sprintf(max+1,"%.*d", next-(max+1), atoi(max+1) - 1);
*next = ch;
}
! if (iter != 1 || *max == ',') {
regparse = origparse; /* back up input pointer */
regnpar = orignpar; /* don't make more parens */
}
***************
*** 793,804 ****
register char *ret;
register int def;
if (*regparse == '^') { /* Complement of range. */
- ret = regnode(ANYBUT);
regparse++;
def = 0;
} else {
- ret = regnode(ANYOF);
def = 255;
}
bits = regcode;
--- 831,841 ----
register char *ret;
register int def;
+ ret = regnode(ANYOF);
if (*regparse == '^') { /* Complement of range. */
regparse++;
def = 0;
} else {
def = 255;
}
bits = regcode;
***************
*** 805,812 ****
for (class = 0; class < 32; class++)
regc(def);
if (*regparse == ']' || *regparse == '-')
! regset(bits,def,lastclass = *regparse++);
while (regparse < regxend && *regparse != ']') {
class = UCHARAT(regparse++);
if (class == '\\') {
class = UCHARAT(regparse++);
--- 842,850 ----
for (class = 0; class < 32; class++)
regc(def);
if (*regparse == ']' || *regparse == '-')
! goto skipcond; /* allow 1st char to be ] or - */
while (regparse < regxend && *regparse != ']') {
+ skipcond:
class = UCHARAT(regparse++);
if (class == '\\') {
class = UCHARAT(regparse++);
***************
*** 863,881 ****
break;
}
}
- if (!range && class == '-' && regparse < regxend &&
- *regparse != ']') {
- range = 1;
- continue;
- }
if (range) {
if (lastclass > class)
FAIL("invalid [] range in regexp");
}
! else
! lastclass = class - 1;
! range = 0;
! for (lastclass++; lastclass <= class; lastclass++) {
regset(bits,def,lastclass);
if (regfold && isupper(lastclass))
regset(bits,def,tolower(lastclass));
--- 901,921 ----
break;
}
}
if (range) {
if (lastclass > class)
FAIL("invalid [] range in regexp");
+ range = 0;
}
! else {
! lastclass = class;
! if (*regparse == '-' && regparse+1 < regxend &&
! regparse[1] != ']') {
! regparse++;
! range = 1;
! continue; /* do it next time */
! }
! }
! for ( ; lastclass <= class; lastclass++) {
regset(bits,def,lastclass);
if (regfold && isupper(lastclass))
regset(bits,def,tolower(lastclass));
***************
*** 949,960 ****
register char *src;
register char *dst;
register char *place;
if (regcode == ®dummy) {
#ifdef REGALIGN
! regsize += 4;
#else
! regsize += 3;
#endif
return;
}
--- 989,1001 ----
register char *src;
register char *dst;
register char *place;
+ register offset = (op == CURLY ? 4 : 0);
if (regcode == ®dummy) {
#ifdef REGALIGN
! regsize += 4 + offset;
#else
! regsize += 3 + offset;
#endif
return;
}
***************
*** 961,969 ****
src = regcode;
#ifdef REGALIGN
! regcode += 4;
#else
! regcode += 3;
#endif
dst = regcode;
while (src > opnd)
--- 1002,1010 ----
src = regcode;
#ifdef REGALIGN
! regcode += 4 + offset;
#else
! regcode += 3 + offset;
#endif
dst = regcode;
while (src > opnd)
***************
*** 973,978 ****
--- 1014,1021 ----
*place++ = op;
*place++ = '\0';
*place++ = '\0';
+ while (offset-- > 0)
+ *place++ = '\0';
}
/*
***************
*** 1081,1087 ****
else
fprintf(stderr,"(%d)", (s-r->program)+(next-s));
s += 3;
! if (op == ANYOF || op == ANYBUT) {
s += 32;
}
if (op == EXACTLY) {
--- 1124,1130 ----
else
fprintf(stderr,"(%d)", (s-r->program)+(next-s));
s += 3;
! if (op == ANYOF) {
s += 32;
}
if (op == EXACTLY) {
***************
*** 1101,1108 ****
fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
if (r->regstclass)
fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
! if (r->reganch)
fprintf(stderr,"anchored ");
if (r->regmust != NULL)
fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,
r->regback);
--- 1144,1153 ----
fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
if (r->regstclass)
fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
! if (r->reganch & 1)
fprintf(stderr,"anchored ");
+ if (r->reganch & 2)
+ fprintf(stderr,"plus ");
if (r->regmust != NULL)
fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,
r->regback);
***************
*** 1133,1141 ****
case ANYOF:
p = "ANYOF";
break;
- case ANYBUT:
- p = "ANYBUT";
- break;
case BRANCH:
p = "BRANCH";
break;
--- 1178,1183 ----
***************
*** 1174,1179 ****
--- 1216,1226 ----
break;
case NDIGIT:
p = "NDIGIT";
+ break;
+ case CURLY:
+ (void)sprintf(buf+strlen(buf), "CURLY {%d,%d}",
+ ARG1(op),ARG2(op));
+ p = NULL;
break;
case REF:
case REF+1:
Index: regcomp.h
Prereq: 3.0
*** regcomp.h.old Thu Aug 9 06:04:56 1990
--- regcomp.h Thu Aug 9 06:04:57 1990
***************
*** 1,6 ****
! /* $Header: regcomp.h,v 3.0 89/10/18 15:22:39 lwall Locked $
*
* $Log: regcomp.h,v $
* Revision 3.0 89/10/18 15:22:39 lwall
* 3.0 baseline
*
--- 1,9 ----
! /* $Header: regcomp.h,v 3.0.1.1 90/08/09 05:06:49 lwall Locked $
*
* $Log: regcomp.h,v $
+ * Revision 3.0.1.1 90/08/09 05:06:49 lwall
+ * patch19: sped up {m,n} on simple items
+ *
* Revision 3.0 89/10/18 15:22:39 lwall
* 3.0 baseline
*
***************
*** 57,64 ****
#define BOL 1 /* no Match "" at beginning of line. */
#define EOL 2 /* no Match "" at end of line. */
#define ANY 3 /* no Match any one character. */
! #define ANYOF 4 /* str Match any character in this string. */
! #define ANYBUT 5 /* str Match any character not in this string. */
#define BRANCH 6 /* node Match this alternative, or the next... */
#define BACK 7 /* no Match "", "next" ptr points backward. */
#define EXACTLY 8 /* str Match this string (preceded by length). */
--- 60,67 ----
#define BOL 1 /* no Match "" at beginning of line. */
#define EOL 2 /* no Match "" at end of line. */
#define ANY 3 /* no Match any one character. */
! #define ANYOF 4 /* str Match character in (or not in) this class. */
! #define CURLY 5 /* str Match this simple thing {n,m} times. */
#define BRANCH 6 /* node Match this alternative, or the next... */
#define BACK 7 /* no Match "", "next" ptr points backward. */
#define EXACTLY 8 /* str Match this string (preceded by length). */
***************
*** 105,111 ****
#ifndef DOINIT
extern char varies[];
#else
! char varies[] = {BRANCH,BACK,STAR,PLUS,
REF+1,REF+2,REF+3,REF+4,REF+5,REF+6,REF+7,REF+8,REF+9,0};
#endif
--- 108,114 ----
#ifndef DOINIT
extern char varies[];
#else
! char varies[] = {BRANCH,BACK,STAR,PLUS,CURLY,
REF+1,REF+2,REF+3,REF+4,REF+5,REF+6,REF+7,REF+8,REF+9,0};
#endif
***************
*** 113,119 ****
#ifndef DOINIT
extern char simple[];
#else
! char simple[] = {ANY,ANYOF,ANYBUT,ALNUM,NALNUM,SPACE,NSPACE,DIGIT,NDIGIT,0};
#endif
EXT char regdummy;
--- 116,122 ----
#ifndef DOINIT
extern char simple[];
#else
! char simple[] = {ANY,ANYOF,ALNUM,NALNUM,SPACE,NSPACE,DIGIT,NDIGIT,0};
#endif
EXT char regdummy;
***************
*** 145,152 ****
--- 148,159 ----
#ifndef lint
#ifdef REGALIGN
#define NEXT(p) (*(short*)(p+1))
+ #define ARG1(p) (*(unsigned short*)(p+3))
+ #define ARG2(p) (*(unsigned short*)(p+5))
#else
#define NEXT(p) (((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
+ #define ARG1(p) (((*((p)+3)&0377)<<8) + (*((p)+4)&0377))
+ #define ARG2(p) (((*((p)+5)&0377)<<8) + (*((p)+6)&0377))
#endif
#else /* lint */
#define NEXT(p) 0
Index: regexec.c
Prereq: 3.0.1.3
*** regexec.c.old Thu Aug 9 06:05:04 1990
--- regexec.c Thu Aug 9 06:05:06 1990
***************
*** 7,15 ****
* blame Henry for some of the lack of readability.
*/
! /* $Header: regexec.c,v 3.0.1.3 90/02/28 18:14:39 lwall Locked $
*
* $Log: regexec.c,v $
* Revision 3.0.1.3 90/02/28 18:14:39 lwall
* patch9: /[\200-\377]/ didn't work on machines with signed chars
* patch9: \d, \w, and \s could misfire on characters with high bit set
--- 7,22 ----
* blame Henry for some of the lack of readability.
*/
! /* $Header: regexec.c,v 3.0.1.4 90/08/09 05:12:03 lwall Locked $
*
* $Log: regexec.c,v $
+ * Revision 3.0.1.4 90/08/09 05:12:03 lwall
+ * patch19: sped up /x+y/ patterns greatly by not retrying on every x
+ * patch19: inhibited backoff on patterns anchored to the end like /\s+$/
+ * patch19: sped up {m,n} on simple items
+ * patch19: $' broke on embedded nulls
+ * patch19: $ will now only match at end of string if $* == 0
+ *
* Revision 3.0.1.3 90/02/28 18:14:39 lwall
* patch9: /[\200-\377]/ didn't work on machines with signed chars
* patch9: \d, \w, and \s could misfire on characters with high bit set
***************
*** 198,204 ****
/* Simplest case: anchored match need be tried only once. */
/* [unless multiline is set] */
! if (prog->reganch) {
if (regtry(prog, string))
goto got_it;
else if (multiline) {
--- 205,211 ----
/* Simplest case: anchored match need be tried only once. */
/* [unless multiline is set] */
! if (prog->reganch & 1) {
if (regtry(prog, string))
goto got_it;
else if (multiline) {
***************
*** 208,216 ****
/* for multiline we only have to try after newlines */
if (s > string)
s--;
! for (; s < strend; s++) {
! if (*s == '\n') {
! if (++s < strend && regtry(prog, s))
goto got_it;
}
}
--- 215,223 ----
/* for multiline we only have to try after newlines */
if (s > string)
s--;
! while (s < strend) {
! if (*s++ == '\n') {
! if (s < strend && regtry(prog, s))
goto got_it;
}
}
***************
*** 220,227 ****
/* Messy cases: unanchored match. */
if (prog->regstart) {
! /* We know what string it must start with. */
! if (prog->regstart->str_pok == 3) {
#ifndef lint
while ((s = fbminstr((unsigned char*)s,
(unsigned char*)strend, prog->regstart)) != NULL)
--- 227,248 ----
/* Messy cases: unanchored match. */
if (prog->regstart) {
! if (prog->reganch & 2) { /* we have /x+whatever/ */
! /* it must be a one character string */
! i = prog->regstart->str_ptr[0];
! while (s < strend) {
! if (*s == i) {
! if (regtry(prog, s))
! goto got_it;
! s++;
! while (s < strend && *s == i)
! s++;
! }
! s++;
! }
! }
! else if (prog->regstart->str_pok == 3) {
! /* We know what string it must start with. */
#ifndef lint
while ((s = fbminstr((unsigned char*)s,
(unsigned char*)strend, prog->regstart)) != NULL)
***************
*** 246,263 ****
goto phooey;
}
if (c = prog->regstclass) {
if (minlen)
dontbother = minlen - 1;
strend -= dontbother; /* don't bother with what can't match */
/* We know what class it must start with. */
switch (OP(c)) {
! case ANYOF: case ANYBUT:
c = OPERAND(c);
while (s < strend) {
i = UCHARAT(s);
! if (!(c[i >> 3] & (1 << (i&7))))
! if (regtry(prog, s))
goto got_it;
s++;
}
break;
--- 267,292 ----
goto phooey;
}
if (c = prog->regstclass) {
+ int doevery = (prog->reganch & 2) == 0;
+
if (minlen)
dontbother = minlen - 1;
strend -= dontbother; /* don't bother with what can't match */
+ tmp = 1;
/* We know what class it must start with. */
switch (OP(c)) {
! case ANYOF:
c = OPERAND(c);
while (s < strend) {
i = UCHARAT(s);
! if (!(c[i >> 3] & (1 << (i&7)))) {
! if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
***************
*** 305,313 ****
case ALNUM:
while (s < strend) {
i = *s;
! if (isALNUM(i))
! if (regtry(prog, s))
goto got_it;
s++;
}
break;
--- 334,347 ----
case ALNUM:
while (s < strend) {
i = *s;
! if (isALNUM(i)) {
! if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
***************
*** 314,354 ****
case NALNUM:
while (s < strend) {
i = *s;
! if (!isALNUM(i))
! if (regtry(prog, s))
goto got_it;
s++;
}
break;
case SPACE:
while (s < strend) {
! if (isSPACE(*s))
! if (regtry(prog, s))
goto got_it;
s++;
}
break;
case NSPACE:
while (s < strend) {
! if (!isSPACE(*s))
! if (regtry(prog, s))
goto got_it;
s++;
}
break;
case DIGIT:
while (s < strend) {
! if (isDIGIT(*s))
! if (regtry(prog, s))
goto got_it;
s++;
}
break;
case NDIGIT:
while (s < strend) {
! if (!isDIGIT(*s))
! if (regtry(prog, s))
goto got_it;
s++;
}
break;
--- 348,413 ----
case NALNUM:
while (s < strend) {
i = *s;
! if (!isALNUM(i)) {
! if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case SPACE:
while (s < strend) {
! if (isSPACE(*s)) {
! if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case NSPACE:
while (s < strend) {
! if (!isSPACE(*s)) {
! if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case DIGIT:
while (s < strend) {
! if (isDIGIT(*s)) {
! if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
case NDIGIT:
while (s < strend) {
! if (!isDIGIT(*s)) {
! if (tmp && regtry(prog, s))
goto got_it;
+ else
+ tmp = doevery;
+ }
+ else
+ tmp = 1;
s++;
}
break;
***************
*** 379,384 ****
--- 438,444 ----
if (prog->subbase)
Safefree(prog->subbase);
prog->subbase = s;
+ prog->subend = s+i;
}
else
s = prog->subbase;
***************
*** 486,492 ****
((nextchar || locinput < regeol) &&
locinput[-1] == '\n') )
{
! regtill--;
break;
}
return(0);
--- 546,552 ----
((nextchar || locinput < regeol) &&
locinput[-1] == '\n') )
{
! regtill = regbol;
break;
}
return(0);
***************
*** 493,499 ****
case EOL:
if ((nextchar || locinput < regeol) && nextchar != '\n')
return(0);
! regtill--;
break;
case ANY:
if ((nextchar == '\0' && locinput >= regeol) ||
--- 553,561 ----
case EOL:
if ((nextchar || locinput < regeol) && nextchar != '\n')
return(0);
! if (!multiline && regeol - locinput > 1)
! return 0;
! regtill = regbol;
break;
case ANY:
if ((nextchar == '\0' && locinput >= regeol) ||
***************
*** 507,513 ****
/* Inline the first character, for speed. */
if (*s != nextchar)
return(0);
! if (locinput + ln > regeol)
return 0;
if (ln > 1 && bcmp(s, locinput, ln) != 0)
return(0);
--- 569,575 ----
/* Inline the first character, for speed. */
if (*s != nextchar)
return(0);
! if (regeol - locinput < ln)
return 0;
if (ln > 1 && bcmp(s, locinput, ln) != 0)
return(0);
***************
*** 515,521 ****
nextchar = *locinput;
break;
case ANYOF:
- case ANYBUT:
s = OPERAND(scan);
if (nextchar < 0)
nextchar = UCHARAT(locinput);
--- 577,582 ----
***************
*** 685,703 ****
}
}
break;
case STAR:
case PLUS:
/*
* Lookahead to avoid useless match attempts
* when we know what character comes next.
*/
if (OP(next) == EXACTLY)
nextchar = *(OPERAND(next)+1);
else
nextchar = -1000;
- ln = (OP(scan) == STAR) ? 0 : 1;
reginput = locinput;
! n = regrepeat(NEXTOPER(scan));
while (n >= ln) {
/* If it could work, try it. */
if (nextchar == -1000 || *reginput == nextchar)
--- 746,778 ----
}
}
break;
+ case CURLY:
+ ln = ARG1(scan); /* min to match */
+ n = ARG2(scan); /* max to match */
+ scan = NEXTOPER(scan) + 4;
+ goto repeat;
case STAR:
+ ln = 0;
+ n = 0;
+ scan = NEXTOPER(scan);
+ goto repeat;
case PLUS:
/*
* Lookahead to avoid useless match attempts
* when we know what character comes next.
*/
+ ln = 1;
+ n = 0;
+ scan = NEXTOPER(scan);
+ repeat:
if (OP(next) == EXACTLY)
nextchar = *(OPERAND(next)+1);
else
nextchar = -1000;
reginput = locinput;
! n = regrepeat(scan, n);
! if (!multiline && OP(next) == EOL)
! ln = n; /* why back off? */
while (n >= ln) {
/* If it could work, try it. */
if (nextchar == -1000 || *reginput == nextchar)
***************
*** 739,746 ****
* rather than incrementing count on every character.]
*/
static int
! regrepeat(p)
char *p;
{
register char *scan;
register char *opnd;
--- 814,822 ----
* rather than incrementing count on every character.]
*/
static int
! regrepeat(p, max)
char *p;
+ int max;
{
register char *scan;
register char *opnd;
***************
*** 748,753 ****
--- 824,831 ----
register char *loceol = regeol;
scan = reginput;
+ if (max && max < loceol - scan)
+ loceol = scan + max;
opnd = OPERAND(p);
switch (OP(p)) {
case ANY:
***************
*** 760,766 ****
scan++;
break;
case ANYOF:
- case ANYBUT:
c = UCHARAT(scan);
while (scan < loceol && !(opnd[c >> 3] & (1 << (c & 7)))) {
scan++;
--- 838,843 ----
Index: regexp.h
Prereq: 3.0
*** regexp.h.old Thu Aug 9 06:05:11 1990
--- regexp.h Thu Aug 9 06:05:12 1990
***************
*** 5,13 ****
* not the System V one.
*/
! /* $Header: regexp.h,v 3.0 89/10/18 15:22:46 lwall Locked $
*
* $Log: regexp.h,v $
* Revision 3.0 89/10/18 15:22:46 lwall
* 3.0 baseline
*
--- 5,16 ----
* not the System V one.
*/
! /* $Header: regexp.h,v 3.0.1.1 90/08/09 05:12:55 lwall Locked $
*
* $Log: regexp.h,v $
+ * Revision 3.0.1.1 90/08/09 05:12:55 lwall
+ * patch19: $' broke on embedded nulls
+ *
* Revision 3.0 89/10/18 15:22:46 lwall
* 3.0 baseline
*
***************
*** 24,29 ****
--- 27,33 ----
int regback; /* Can regmust locate first try? */
char *precomp; /* pre-compilation regular expression */
char *subbase; /* saved string so \digit works forever */
+ char *subend; /* end of subbase */
char reganch; /* Internal use only. */
char do_folding; /* do case-insensitive match? */
char lastparen; /* last paren matched */
Index: eg/relink
*** eg/relink.old Thu Aug 9 05:58:22 1990
--- eg/relink Thu Aug 9 05:58:23 1990
***************
*** 1,14 ****
#!/usr/bin/perl
($op = shift) || die "Usage: relink perlexpr [filenames]\n";
if (!@ARGV) {
! if (-t) {
! @ARGV = <*>;
! }
! else {
! @ARGV = <STDIN>;
! chop(@ARGV);
! }
}
for (@ARGV) {
next unless -l; # symbolic link?
--- 1,18 ----
#!/usr/bin/perl
+ 'di';
+ 'ig00';
+ #
+ # $Header: relink,v 3.0.1.2 90/08/09 03:17:44 lwall Locked $
+ #
+ # $Log: relink,v $
+ # Revision 3.0.1.2 90/08/09 03:17:44 lwall
+ # patch19: added man page for relink and rename
+ #
($op = shift) || die "Usage: relink perlexpr [filenames]\n";
if (!@ARGV) {
! @ARGV = <STDIN>;
! chop(@ARGV);
}
for (@ARGV) {
next unless -l; # symbolic link?
***************
*** 22,24 ****
--- 26,85 ----
symlink($_, $name);
}
}
+ ##############################################################################
+
+ # These next few lines are legal in both Perl and nroff.
+
+ .00; # finish .ig
+
+ 'di \" finish diversion--previous line must be blank
+ .nr nl 0-1 \" fake up transition to first page again
+ .nr % 0 \" start at page 1
+ ';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
+ .TH RELINK 1 "July 30, 1990"
+ .AT 3
+ .SH LINK
+ relink \- relinks multiple symbolic links
+ .SH SYNOPSIS
+ .B relink perlexpr [symlinknames]
+ .SH DESCRIPTION
+ .I Relink
+ relinks the symbolic links given according to the rule specified as the
+ first argument.
+ The argument is a Perl expression which is expected to modify the $_
+ string in Perl for at least some of the names specified.
+ For each symbolic link named on the command line, the Perl expression
+ will be executed on the contents of the symbolic link with that name.
+ If a given symbolic link's contents is not modified by the expression,
+ it will not be changed.
+ If a name given on the command line is not a symbolic link, it will be ignored.
+ If no names are given on the command line, names will be read
+ via standard input.
+ .PP
+ For example, to relink all symbolic links in the current directory
+ pointing to somewhere in X11R3 so that they point to X11R4, you might say
+ .nf
+
+ relink 's/X11R3/X11R4/' *
+
+ .fi
+ To change all occurences of links in the system from /usr/spool to /var/spool,
+ you'd say
+ .nf
+
+ find / -type l -print | relink 's#/usr/spool#/var/spool#'
+
+ .fi
+ .SH ENVIRONMENT
+ No environment variables are used.
+ .SH FILES
+ .SH AUTHOR
+ Larry Wall
+ .SH "SEE ALSO"
+ ln(1)
+ .br
+ perl(1)
+ .SH DIAGNOSTICS
+ If you give an invalid Perl expression you'll get a syntax error.
+ .SH BUGS
+ .ex
Index: eg/rename
*** eg/rename.old Thu Aug 9 05:58:26 1990
--- eg/rename Thu Aug 9 05:58:27 1990
***************
*** 1,14 ****
#!/usr/bin/perl
($op = shift) || die "Usage: rename perlexpr [filenames]\n";
if (!@ARGV) {
! if (-t) {
! @ARGV = <*>;
! }
! else {
! @ARGV = <STDIN>;
! chop(@ARGV);
! }
}
for (@ARGV) {
$was = $_;
--- 1,18 ----
#!/usr/bin/perl
+ 'di';
+ 'ig00';
+ #
+ # $Header: rename,v 3.0.1.2 90/08/09 03:17:57 lwall Locked $
+ #
+ # $Log: rename,v $
+ # Revision 3.0.1.2 90/08/09 03:17:57 lwall
+ # patch19: added man page for relink and rename
+ #
($op = shift) || die "Usage: rename perlexpr [filenames]\n";
if (!@ARGV) {
! @ARGV = <STDIN>;
! chop(@ARGV);
}
for (@ARGV) {
$was = $_;
***************
*** 16,18 ****
--- 20,77 ----
die $@ if $@;
rename($was,$_) unless $was eq $_;
}
+ ##############################################################################
+
+ # These next few lines are legal in both Perl and nroff.
+
+ .00; # finish .ig
+
+ 'di \" finish diversion--previous line must be blank
+ .nr nl 0-1 \" fake up transition to first page again
+ .nr % 0 \" start at page 1
+ ';<<'.ex'; #__END__ ############# From here on it's a standard manual page ############
+ .TH RENAME 1 "July 30, 1990"
+ .AT 3
+ .SH NAME
+ rename \- renames multiple files
+ .SH SYNOPSIS
+ .B rename perlexpr [files]
+ .SH DESCRIPTION
+ .I Rename
+ renames the filenames supplied according to the rule specified as the
+ first argument.
+ The argument is a Perl expression which is expected to modify the $_
+ string in Perl for at least some of the filenames specified.
+ If a given filename is not modified by the expression, it will not be
+ renamed.
+ If no filenames are given on the command line, filenames will be read
+ via standard input.
+ .PP
+ For example, to rename all files matching *.bak to strip the extension,
+ you might say
+ .nf
+
+ rename 's/\e.bak$//' *.bak
+
+ .fi
+ To translate uppercase names to lower, you'd use
+ .nf
+
+ rename 'y/A-Z/a-z/' *
+
+ .fi
+ .SH ENVIRONMENT
+ No environment variables are used.
+ .SH FILES
+ .SH AUTHOR
+ Larry Wall
+ .SH "SEE ALSO"
+ mv(1)
+ .br
+ perl(1)
+ .SH DIAGNOSTICS
+ If you give an invalid Perl expression you'll get a syntax error.
+ .SH BUGS
+ .I Rename
+ does not check for the existence of target filenames, so use with care.
+ .ex
Index: x2p/s2p.SH
Prereq: 3.0.1.3
*** x2p/s2p.SH.old Thu Aug 9 06:07:06 1990
--- x2p/s2p.SH Thu Aug 9 06:07:07 1990
***************
*** 28,36 ****
: In the following dollars and backticks do not need the extra backslash.
$spitshell >>s2p <<'!NO!SUBS!'
! # $Header: s2p.SH,v 3.0.1.3 90/03/01 10:31:21 lwall Locked $
#
# $Log: s2p.SH,v $
# Revision 3.0.1.3 90/03/01 10:31:21 lwall
# patch9: s2p didn't handle \< and \>
#
--- 28,39 ----
: In the following dollars and backticks do not need the extra backslash.
$spitshell >>s2p <<'!NO!SUBS!'
! # $Header: s2p.SH,v 3.0.1.4 90/08/09 05:50:43 lwall Locked $
#
# $Log: s2p.SH,v $
+ # Revision 3.0.1.4 90/08/09 05:50:43 lwall
+ # patch19: s2p didn't translate \n right
+ #
# Revision 3.0.1.3 90/03/01 10:31:21 lwall
# patch9: s2p didn't handle \< and \>
#
***************
*** 424,429 ****
--- 427,435 ----
$len = length($_);
$_ = substr($_,0,--$len);
}
+ elsif (substr($_,$i,1) =~ /^[n]$/) {
+ ;
+ }
elsif (!$repl && substr($_,$i,1) =~ /^[(){}\w]$/) {
$i--;
$len--;
***************
*** 612,618 ****
if ($delim eq '\\') {
s/(.)//;
$ch = $1;
! $delim = '' if $ch =~ /^[(){}\w]$/;
$ch = 'b' if $ch =~ /^[<>]$/;
$delim .= $ch;
}
--- 618,624 ----
if ($delim eq '\\') {
s/(.)//;
$ch = $1;
! $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
$ch = 'b' if $ch =~ /^[<>]$/;
$delim .= $ch;
}
Index: h2pl/eg/sizeof.ph
*** h2pl/eg/sizeof.ph.old Thu Aug 9 05:59:29 1990
--- h2pl/eg/sizeof.ph Thu Aug 9 05:59:30 1990
***************
*** 0 ****
--- 1,14 ----
+ $sizeof{'char'} = 1;
+ $sizeof{'int'} = 4;
+ $sizeof{'long'} = 4;
+ $sizeof{'struct arpreq'} = 36;
+ $sizeof{'struct ifconf'} = 8;
+ $sizeof{'struct ifreq'} = 32;
+ $sizeof{'struct ltchars'} = 6;
+ $sizeof{'struct pcntl'} = 116;
+ $sizeof{'struct rtentry'} = 52;
+ $sizeof{'struct sgttyb'} = 6;
+ $sizeof{'struct tchars'} = 6;
+ $sizeof{'struct ttychars'} = 14;
+ $sizeof{'struct winsize'} = 8;
+ $sizeof{'struct termios'} = 132;
Index: stab.c
Prereq: 3.0.1.6
*** stab.c.old Thu Aug 9 06:05:19 1990
--- stab.c Thu Aug 9 06:05:22 1990
***************
*** 1,4 ****
! /* $Header: stab.c,v 3.0.1.6 90/03/27 16:22:11 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: stab.c,v 3.0.1.7 90/08/09 05:17:48 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,20 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: stab.c,v $
+ * Revision 3.0.1.7 90/08/09 05:17:48 lwall
+ * patch19: fixed double include of <signal.h>
+ * patch19: $' broke on embedded nulls
+ * patch19: $< and $> better supported on machines without setreuid
+ * patch19: Added support for linked-in C subroutines
+ * patch19: %ENV wasn't forced to be global like it should
+ * patch19: $| didn't work before the filehandle was opened
+ * patch19: $! now returns "" in string context if errno == 0
+ *
* Revision 3.0.1.6 90/03/27 16:22:11 lwall
* patch16: support for machines that can't cast negative floats to unsigned ints
*
***************
*** 38,44 ****
--- 47,55 ----
#include "EXTERN.h"
#include "perl.h"
+ #ifndef NSIG
#include <signal.h>
+ #endif
static char *sig_name[] = {
SIG_NAME,0
***************
*** 105,111 ****
if (curspat) {
if (curspat->spat_regexp &&
(s = curspat->spat_regexp->endp[0]) ) {
! str_set(stab_val(stab),s);
}
else
str_nset(stab_val(stab),"",0);
--- 116,122 ----
if (curspat) {
if (curspat->spat_regexp &&
(s = curspat->spat_regexp->endp[0]) ) {
! str_nset(stab_val(stab),s, curspat->spat_regexp->subend - s);
}
else
str_nset(stab_val(stab),"",0);
***************
*** 151,156 ****
--- 162,169 ----
str_numset(stab_val(stab),(double)arybase);
break;
case '|':
+ if (!stab_io(curoutstab))
+ stab_io(curoutstab) = stio_new();
str_numset(stab_val(stab),
(double)((stab_io(curoutstab)->flags & IOF_FLUSH) != 0) );
break;
***************
*** 165,171 ****
break;
case '!':
str_numset(stab_val(stab), (double)errno);
! str_set(stab_val(stab), strerror(errno));
stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
break;
case '<':
--- 178,184 ----
break;
case '!':
str_numset(stab_val(stab), (double)errno);
! str_set(stab_val(stab), errno ? strerror(errno) : "");
stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
break;
case '<':
***************
*** 199,204 ****
--- 212,225 ----
#endif
str_set(stab_val(stab),buf);
break;
+ default:
+ {
+ struct ufuncs *uf = (struct ufuncs *)str->str_ptr;
+
+ if (uf && uf->uf_val)
+ uf->uf_val(uf->uf_index, stab_val(stab));
+ }
+ break;
}
return stab_val(stab);
}
***************
*** 256,265 ****
stab->str_pok = 1;
strcpy(stab_magic(stab),"StB");
stab_val(stab) = Str_new(70,0);
! stab_line(stab) = line;
}
! else
stab = stabent(s,TRUE);
str_sset(str,stab);
}
break;
--- 277,293 ----
stab->str_pok = 1;
strcpy(stab_magic(stab),"StB");
stab_val(stab) = Str_new(70,0);
! stab_line(stab) = curcmd->c_line;
}
! else {
stab = stabent(s,TRUE);
+ if (!stab_xarray(stab))
+ aadd(stab);
+ if (!stab_xhash(stab))
+ hadd(stab);
+ if (!stab_io(stab))
+ stab_io(stab) = stio_new();
+ }
str_sset(str,stab);
}
break;
***************
*** 305,310 ****
--- 333,340 ----
stab_io(curoutstab)->page = (long)str_gnum(str);
break;
case '|':
+ if (!stab_io(curoutstab))
+ stab_io(curoutstab) = stio_new();
stab_io(curoutstab)->flags &= ~IOF_FLUSH;
if (str_gnum(str) != 0.0) {
stab_io(curoutstab)->flags |= IOF_FLUSH;
***************
*** 366,372 ****
if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
uid = (int)getuid();
#else
! fatal("setruid() not implemented");
#endif
#endif
break;
--- 396,405 ----
if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0)
uid = (int)getuid();
#else
! if (uid == euid) /* special case $< = $> */
! setuid(uid);
! else
! fatal("setruid() not implemented");
#endif
#endif
break;
***************
*** 386,392 ****
if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
euid = (int)geteuid();
#else
! fatal("seteuid() not implemented");
#endif
#endif
break;
--- 419,428 ----
if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0)
euid = (int)geteuid();
#else
! if (euid == uid) /* special case $> = $< */
! setuid(euid);
! else
! fatal("seteuid() not implemented");
#endif
#endif
break;
***************
*** 429,434 ****
--- 465,478 ----
case ':':
chopset = str_get(str);
break;
+ default:
+ {
+ struct ufuncs *uf = (struct ufuncs *)str->str_magic->str_ptr;
+
+ if (uf && uf->uf_set)
+ uf->uf_set(uf->uf_index, str);
+ }
+ break;
}
break;
}
***************
*** 465,470 ****
--- 509,517 ----
ARRAY *oldstack = stack;
SUBR *sub;
+ #ifdef OS2 /* or anybody else who requires SIG_ACK */
+ signal(sig, SIG_ACK);
+ #endif
stab = stabent(
str_get(hfetch(stab_hash(sigstab),sig_name[sig],strlen(sig_name[sig]),
TRUE)), TRUE);
***************
*** 555,561 ****
if (*name == 'I' && strEQ(name, "INC"))
global = TRUE;
}
! else if (*name >= 'A') {
if (*name == 'E' && strEQ(name, "ENV"))
global = TRUE;
}
--- 602,608 ----
if (*name == 'I' && strEQ(name, "INC"))
global = TRUE;
}
! else if (*name > 'A') {
if (*name == 'E' && strEQ(name, "ENV"))
global = TRUE;
}
***************
*** 615,621 ****
stab->str_pok = 1;
strcpy(stab_magic(stab),"StB");
stab_val(stab) = Str_new(72,0);
! stab_line(stab) = line;
str_magic(stab,stab,'*',name,len);
return stab;
}
--- 662,668 ----
stab->str_pok = 1;
strcpy(stab_magic(stab),"StB");
stab_val(stab) = Str_new(72,0);
! stab_line(stab) = curcmd->c_line;
str_magic(stab,stab,'*',name,len);
return stab;
}
***************
*** 644,650 ****
stab = (STAB*)entry->hent_val;
if (stab->str_pok & SP_MULTI)
continue;
! line = stab_line(stab);
warn("Possible typo: \"%s\"", stab_name(stab));
}
}
--- 691,697 ----
stab = (STAB*)entry->hent_val;
if (stab->str_pok & SP_MULTI)
continue;
! curcmd->c_line = stab_line(stab);
warn("Possible typo: \"%s\"", stab_name(stab));
}
}
*** End of Patch 25 ***
More information about the Comp.sources.bugs
mailing list