perl 3.0 patch #8 (REPOST)
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Thu Jan 18 10:10:49 AEST 1990
System: perl version 3.0
Patch #: 8
Priority: Medium High
Subject: patch 7 continued
Description:
See patch 7.
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:
rm config.sh
Configure
make depend
make
make test
make install
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: 7
1c1
< #define PATCHLEVEL 7
---
> #define PATCHLEVEL 8
Index: cons.c
Prereq: 3.0.1.2
*** cons.c.old Thu Dec 21 20:33:49 1989
--- cons.c Thu Dec 21 20:33:52 1989
***************
*** 1,4 ****
! /* $Header: cons.c,v 3.0.1.2 89/11/17 15:08:53 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: cons.c,v 3.0.1.3 89/12/21 19:20:25 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: cons.c,v $
+ * Revision 3.0.1.3 89/12/21 19:20:25 lwall
+ * patch7: made nested or recursive foreach work right
+ *
* Revision 3.0.1.2 89/11/17 15:08:53 lwall
* patch5: nested foreach on same array didn't work
*
***************
*** 1194,1213 ****
/* Here we check to see if the temporary array generated for
* a foreach needs to be localized because of recursion.
*/
! if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY &&
! lastcmd &&
! lastcmd->c_type == C_EXPR &&
! lastcmd->ucmd.acmd.ac_expr) {
! ARG *arg = lastcmd->ucmd.acmd.ac_expr;
! if (arg->arg_type == O_ASSIGN &&
! arg[1].arg_type == A_LEXPR &&
! arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
! strnEQ("_GEN_",
! stab_name(arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
! 5)) { /* array generated for foreach */
! (void)localize(arg[1].arg_ptr.arg_arg);
}
}
shouldsave |= tmpsave;
}
--- 1197,1222 ----
/* Here we check to see if the temporary array generated for
* a foreach needs to be localized because of recursion.
*/
! if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
! if (lastcmd &&
! lastcmd->c_type == C_EXPR &&
! lastcmd->ucmd.acmd.ac_expr) {
! ARG *arg = lastcmd->ucmd.acmd.ac_expr;
! if (arg->arg_type == O_ASSIGN &&
! arg[1].arg_type == A_LEXPR &&
! arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY &&
! strnEQ("_GEN_",
! stab_name(
! arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
! 5)) { /* array generated for foreach */
! (void)localize(arg[1].arg_ptr.arg_arg);
! }
}
+
+ /* in any event, save the iterator */
+
+ (void)apush(tosave,cmd->c_short);
}
shouldsave |= tmpsave;
}
Index: doarg.c
Prereq: 3.0.1.1
*** doarg.c.old Thu Dec 21 20:33:59 1989
--- doarg.c Thu Dec 21 20:34:01 1989
***************
*** 1,4 ****
! /* $Header: doarg.c,v 3.0.1.1 89/11/11 04:17:20 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: doarg.c,v 3.0.1.2 89/12/21 19:52:15 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,15 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doarg.c,v $
+ * Revision 3.0.1.2 89/12/21 19:52:15 lwall
+ * patch7: a pattern wouldn't match a null string before the first character
+ * patch7: certain patterns didn't match correctly at end of string
+ *
* Revision 3.0.1.1 89/11/11 04:17:20 lwall
* patch2: printf %c, %D, %X and %O didn't work right
* patch2: printf of unsigned vs signed needed separate casts on some machines
***************
*** 127,133 ****
clen = dstr->str_cur;
if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
/* can do inplace substitution */
! if (regexec(spat->spat_regexp, s, strend, orig, 1,
str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
if (spat->spat_regexp->subbase) /* oops, no we can't */
goto long_way;
--- 131,137 ----
clen = dstr->str_cur;
if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
/* can do inplace substitution */
! if (regexec(spat->spat_regexp, s, strend, orig, 0,
str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
if (spat->spat_regexp->subbase) /* oops, no we can't */
goto long_way;
***************
*** 201,208 ****
d += clen;
}
s = spat->spat_regexp->endp[0];
! } while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr,
! TRUE));
if (s != d) {
i = strend - s;
str->str_cur = d - str->str_ptr + i;
--- 205,212 ----
d += clen;
}
s = spat->spat_regexp->endp[0];
! } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
! Nullstr, TRUE)); /* (don't match same null twice) */
if (s != d) {
i = strend - s;
str->str_cur = d - str->str_ptr + i;
***************
*** 220,226 ****
}
else
c = Nullch;
! if (regexec(spat->spat_regexp, s, strend, orig, 1,
str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
long_way:
dstr = Str_new(25,str_len(str));
--- 224,230 ----
}
else
c = Nullch;
! if (regexec(spat->spat_regexp, s, strend, orig, 0,
str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
long_way:
dstr = Str_new(25,str_len(str));
***************
*** 252,258 ****
}
if (once)
break;
! } while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr,
safebase));
str_ncat(dstr,s,strend - s);
str_replace(str,dstr);
--- 256,262 ----
}
if (once)
break;
! } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
safebase));
str_ncat(dstr,s,strend - s);
str_replace(str,dstr);
Index: doio.c
Prereq: 3.0.1.3
*** doio.c.old Thu Dec 21 20:34:12 1989
--- doio.c Thu Dec 21 20:34:15 1989
***************
*** 1,4 ****
! /* $Header: doio.c,v 3.0.1.3 89/11/17 15:13:06 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: doio.c,v 3.0.1.4 89/12/21 19:55:10 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,17 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doio.c,v $
+ * Revision 3.0.1.4 89/12/21 19:55:10 lwall
+ * patch7: select now works on big-endian machines
+ * patch7: errno may now be a macro with an lvalue
+ * patch7: ANSI strerror() is now supported
+ * patch7: Configure now detects DG/UX thingies like [sg]etpgrp2 and utime.h
+ *
* Revision 3.0.1.3 89/11/17 15:13:06 lwall
* patch5: some systems have symlink() but not lstat()
* patch5: some systems have dirent.h but not readdir()
***************
*** 36,42 ****
#include <netdb.h>
#endif
- #include <errno.h>
#ifdef I_PWD
#include <pwd.h>
#endif
--- 42,47 ----
***************
*** 43,51 ****
#ifdef I_GRP
#include <grp.h>
#endif
- extern int errno;
-
bool
do_open(stab,name)
STAB *stab;
--- 48,57 ----
#ifdef I_GRP
#include <grp.h>
#endif
+ #ifdef I_UTIME
+ #include <utime.h>
+ #endif
bool
do_open(stab,name)
STAB *stab;
***************
*** 1475,1494 ****
int nfound;
struct timeval timebuf;
struct timeval *tbuf = &timebuf;
for (i = 1; i <= 3; i++) {
! j = st[sp+i]->str_len;
if (maxlen < j)
maxlen = j;
}
for (i = 1; i <= 3; i++) {
str = st[sp+i];
j = str->str_len;
! if (j < maxlen) {
if (str->str_pok) {
! str_grow(str,maxlen);
s = str_get(str) + j;
! while (++j <= maxlen) {
*s++ = '\0';
}
}
--- 1481,1532 ----
int nfound;
struct timeval timebuf;
struct timeval *tbuf = &timebuf;
+ int growsize;
+ #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+ int masksize;
+ int offset;
+ char *fd_sets[4];
+ int k;
+ #if BYTEORDER & 0xf0000
+ #define ORDERBYTE (0x88888888 - BYTEORDER)
+ #else
+ #define ORDERBYTE (0x4444 - BYTEORDER)
+ #endif
+
+ #endif
+
for (i = 1; i <= 3; i++) {
! j = st[sp+i]->str_cur;
if (maxlen < j)
maxlen = j;
}
+
+ #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+ growsize = maxlen; /* little endians can use vecs directly */
+ #else
+ #ifdef NFDBITS
+
+ #ifndef NBBY
+ #define NBBY 8
+ #endif
+
+ masksize = NFDBITS / NBBY;
+ #else
+ masksize = sizeof(long); /* documented int, everyone seems to use long */
+ #endif
+ growsize = maxlen + (masksize - (maxlen % masksize));
+ Zero(&fd_sets[0], 4, char*);
+ #endif
+
for (i = 1; i <= 3; i++) {
str = st[sp+i];
j = str->str_len;
! if (j < growsize) {
if (str->str_pok) {
! str_grow(str,growsize);
s = str_get(str) + j;
! while (++j <= growsize) {
*s++ = '\0';
}
}
***************
*** 1497,1502 ****
--- 1535,1550 ----
str->str_ptr = Nullch;
}
}
+ #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
+ s = str->str_ptr;
+ if (s) {
+ New(403, fd_sets[i], growsize, char);
+ for (offset = 0; offset < growsize; offset += masksize) {
+ for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
+ fd_sets[i][j+offset] = s[(k % masksize) + offset];
+ }
+ }
+ #endif
}
str = st[sp+4];
if (str->str_nok || str->str_pok) {
***************
*** 1510,1515 ****
--- 1558,1564 ----
else
tbuf = Null(struct timeval*);
+ #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
nfound = select(
maxlen * 8,
st[sp+1]->str_ptr,
***************
*** 1516,1521 ****
--- 1565,1588 ----
st[sp+2]->str_ptr,
st[sp+3]->str_ptr,
tbuf);
+ #else
+ nfound = select(
+ maxlen * 8,
+ fd_sets[1],
+ fd_sets[2],
+ fd_sets[3],
+ tbuf);
+ for (i = 1; i <= 3; i++) {
+ if (fd_sets[i]) {
+ str = st[sp+i];
+ s = str->str_ptr;
+ for (offset = 0; offset < growsize; offset += masksize) {
+ for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
+ s[(k % masksize) + offset] = fd_sets[i][j+offset];
+ }
+ }
+ }
+ #endif
st[++sp] = str_static(&str_no);
str_numset(st[sp], (double)nfound);
***************
*** 1915,1927 ****
taintproper("Insecure dependency in utime");
#endif
if (items > 2) {
struct {
! long atime,
! mtime;
} utbuf;
! utbuf.atime = (long)str_gnum(st[++sp]); /* time accessed */
! utbuf.mtime = (long)str_gnum(st[++sp]); /* time modified */
items -= 2;
#ifndef lint
tot = items;
--- 1982,2002 ----
taintproper("Insecure dependency in utime");
#endif
if (items > 2) {
+ #ifdef I_UTIME
+ struct utimbuf utbuf;
+ #else
struct {
! long actime;
! long modtime;
} utbuf;
+ #endif
! utbuf.actime = (long)str_gnum(st[++sp]); /* time accessed */
! utbuf.modtime = (long)str_gnum(st[++sp]); /* time modified */
! #ifdef I_UTIME
! utbuf.acusec = 0; /* hopefully I_UTIME implies these */
! utbuf.modusec = 0;
! #endif
items -= 2;
#ifndef lint
tot = items;
Index: dolist.c
Prereq: 3.0.1.3
*** dolist.c.old Thu Dec 21 20:34:25 1989
--- dolist.c Thu Dec 21 20:34:28 1989
***************
*** 1,4 ****
! /* $Header: dolist.c,v 3.0.1.3 89/11/17 15:14:45 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: dolist.c,v 3.0.1.4 89/12/21 19:58:46 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,15 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.4 89/12/21 19:58:46 lwall
+ * patch7: grep(1, at array) didn't work
+ * patch7: /$pat/; //; wrongly freed runtime pattern twice
+ *
* Revision 3.0.1.3 89/11/17 15:14:45 lwall
* patch5: grep() occasionally loses arguments or dumps core
*
***************
*** 81,87 ****
if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
! arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
}
if (!spat->spat_regexp->nparens)
--- 85,92 ----
if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
! if (spat->spat_runtime)
! arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
}
if (!spat->spat_regexp->nparens)
***************
*** 729,736 ****
int oldsave = savestack->ary_fill;
savesptr(&stab_val(defstab));
! if ((arg[1].arg_type & A_MASK) != A_EXPR)
dehoist(arg,1);
arg = arg[1].arg_ptr.arg_arg;
while (i-- > 0) {
stab_val(defstab) = st[src];
--- 734,744 ----
int oldsave = savestack->ary_fill;
savesptr(&stab_val(defstab));
! if ((arg[1].arg_type & A_MASK) != A_EXPR) {
! arg[1].arg_type &= A_MASK;
dehoist(arg,1);
+ arg[1].arg_type |= A_DONT;
+ }
arg = arg[1].arg_ptr.arg_arg;
while (i-- > 0) {
stab_val(defstab) = st[src];
Index: eval.c
Prereq: 3.0.1.2
*** eval.c.old Thu Dec 21 20:35:25 1989
--- eval.c Thu Dec 21 20:35:29 1989
***************
*** 1,4 ****
! /* $Header: eval.c,v 3.0.1.2 89/11/17 15:19:34 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: eval.c,v 3.0.1.3 89/12/21 20:03:05 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,13 ****
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: eval.c,v $
* Revision 3.0.1.2 89/11/17 15:19:34 lwall
! * patch5: simplified a too-complex expression for some machine or other
*
* Revision 3.0.1.1 89/11/11 04:31:51 lwall
* patch2: mkdir and rmdir needed to quote argument when passed to shell
--- 6,19 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: eval.c,v $
+ * Revision 3.0.1.3 89/12/21 20:03:05 lwall
+ * patch7: errno may now be a macro with an lvalue
+ * patch7: ANSI strerror() is now supported
+ * patch7: send() didn't allow a TO argument
+ * patch7: ord() now always returns positive even on signed char machines
+ *
* Revision 3.0.1.2 89/11/17 15:19:34 lwall
! * patch5: constant numeric subscripts get lost inside ?:
*
* Revision 3.0.1.1 89/11/11 04:31:51 lwall
* patch2: mkdir and rmdir needed to quote argument when passed to shell
***************
*** 23,36 ****
#include "perl.h"
#include <signal.h>
- #include <errno.h>
#ifdef I_VFORK
# include <vfork.h>
#endif
- extern int errno;
-
#ifdef VOIDSIG
static void (*ihand)();
static void (*qhand)();
--- 29,39 ----
***************
*** 50,58 ****
char *getlogin();
- extern int sys_nerr;
- extern char *sys_errlist[];
-
int
eval(arg,gimme,sp)
register ARG *arg;
--- 53,58 ----
***************
*** 962,968 ****
errno = 0;
if (optype > 4)
warn("Too many args on send");
! if (optype >= 4) {
tmps2 = str_get(st[4]);
anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
anum, tmps2, st[4]->str_cur);
--- 962,974 ----
errno = 0;
if (optype > 4)
warn("Too many args on send");
! stio = stab_io(stab);
! if (!stio || !stio->ifp) {
! anum = -1;
! if (dowarn)
! warn("Send on closed socket");
! }
! else if (optype >= 4) {
tmps2 = str_get(st[4]);
anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
anum, tmps2, st[4]->str_cur);
***************
*** 1197,1206 ****
else
tmps = str_get(st[1]);
#ifndef I286
! value = (double) *tmps;
#else
anum = (int) *tmps;
! value = (double) anum;
#endif
goto donumset;
case O_SLEEP:
--- 1203,1212 ----
else
tmps = str_get(st[1]);
#ifndef I286
! value = (double) (*tmps & 255);
#else
anum = (int) *tmps;
! value = (double) (anum & 255);
#endif
goto donumset;
case O_SLEEP:
Index: hash.c
Prereq: 3.0.1.1
*** hash.c.old Thu Dec 21 20:35:37 1989
--- hash.c Thu Dec 21 20:35:38 1989
***************
*** 1,4 ****
! /* $Header: hash.c,v 3.0.1.1 89/11/11 04:34:18 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: hash.c,v 3.0.1.2 89/12/21 20:03:39 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: hash.c,v $
+ * Revision 3.0.1.2 89/12/21 20:03:39 lwall
+ * patch7: errno may now be a macro with an lvalue
+ *
* Revision 3.0.1.1 89/11/11 04:34:18 lwall
* patch2: CX/UX needed to set the key each time in associative iterators
*
***************
*** 16,24 ****
#include "EXTERN.h"
#include "perl.h"
- #include <errno.h>
-
- extern int errno;
STR *
hfetch(tb,key,klen,lval)
--- 19,24 ----
Index: perl.h
Prereq: 3.0.1.3
*** perl.h.old Thu Dec 21 20:35:51 1989
--- perl.h Thu Dec 21 20:35:53 1989
***************
*** 1,4 ****
! /* $Header: perl.h,v 3.0.1.3 89/11/17 15:28:57 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: perl.h,v 3.0.1.4 89/12/21 20:07:35 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: perl.h,v $
+ * Revision 3.0.1.4 89/12/21 20:07:35 lwall
+ * patch7: arranged for certain registers to be restored after longjmp()
+ * patch7: Configure now compiles a test program to figure out time.h fiasco
+ * patch7: Configure now detects DG/UX thingies like [sg]etpgrp2 and utime.h
+ * patch7: memcpy() and memset() return void in __STDC__
+ * patch7: errno may now be a macro with an lvalue
+ * patch7: ANSI strerror() is now supported
+ * patch7: Xenix support for sys/ndir.h, cross compilation
+ *
* Revision 3.0.1.3 89/11/17 15:28:57 lwall
* patch5: byteorder now is a hex value
* patch5: Configure now looks for <time.h> including <sys/time.h>
***************
*** 26,31 ****
--- 35,48 ----
*
*/
+ #ifdef __STDC__
+ #define VOLATILE volatile
+ #define VREG
+ #else
+ #define VOLATILE
+ #define VREG register
+ #endif
+
#define VOIDUSED 1
#include "config.h"
***************
*** 39,50 ****
--- 56,87 ----
# define vfork fork
#endif
+ #ifdef GETPGRP2
+ # ifndef GETPGRP
+ # define GETPGRP
+ # endif
+ # define getpgrp getpgrp2
+ #endif
+
+ #ifdef SETPGRP2
+ # ifndef SETPGRP
+ # define SETPGRP
+ # endif
+ # define setpgrp setpgrp2
+ #endif
+
#if defined(MEMCMP) && defined(mips) && BYTEORDER == 0x1234
#undef MEMCMP
#endif
#ifdef MEMCPY
+ #ifndef memcpy
+ #ifdef __STDC__
+ extern void *memcpy(), *memset();
+ #else
extern char *memcpy(), *memset();
+ #endif
+ #endif
#define bcopy(s1,s2,l) memcpy(s2,s1,l)
#define bzero(s,l) memset(s,0,l)
#endif
***************
*** 69,88 ****
#include <sys/stat.h>
! #if defined(TMINSYS) || defined(I_SYSTIME)
! #include <sys/time.h>
! #ifdef I_TIMETOO
! #include <time.h>
#endif
! #else
! #include <time.h>
! #ifdef I_SYSTIMETOO
! #include <time.h>
#endif
- #endif
#include <sys/times.h>
#ifdef I_SYSIOCTL
#ifndef _IOCTL_
#include <sys/ioctl.h>
--- 106,144 ----
#include <sys/stat.h>
! #ifdef I_TIME
! # include <time.h>
#endif
!
! #ifdef I_SYSTIME
! # ifdef SYSTIMEKERNEL
! # define KERNEL
! # endif
! # include <sys/time.h>
! # ifdef SYSTIMEKERNEL
! # undef KERNEL
! # endif
#endif
#include <sys/times.h>
+ #if defined(STRERROR) && (!defined(MKDIR) || !defined(RMDIR))
+ #undef STRERROR
+ #endif
+
+ #include <errno.h>
+ #ifndef errno
+ extern int errno; /* ANSI allows errno to be an lvalue expr */
+ #endif
+
+ #ifdef STRERROR
+ char *strerror();
+ #else
+ extern int sys_nerr;
+ extern char *sys_errlist[];
+ #define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
+ #endif
+
#ifdef I_SYSIOCTL
#ifndef _IOCTL_
#include <sys/ioctl.h>
***************
*** 135,152 ****
#define ntohi ntohl
#endif
! #ifdef I_DIRENT
! #include <dirent.h>
! #define DIRENT dirent
#else
! #ifdef I_SYSDIR
! #ifdef hp9000s500
! #include <ndir.h> /* may be wrong in the future */
! #else
! #include <sys/dir.h>
! #endif
! #define DIRENT direct
! #endif
#endif
typedef struct arg ARG;
--- 191,213 ----
#define ntohi ntohl
#endif
! #if defined(I_DIRENT) && !defined(xenix)
! # include <dirent.h>
! # define DIRENT dirent
#else
! # ifdef I_SYSDIR
! # ifdef hp9000s500
! # include <ndir.h> /* may be wrong in the future */
! # else
! # include <sys/dir.h>
! # endif
! # define DIRENT direct
! # else
! # ifdef I_SYSNDIR
! # include <sys/ndir.h>
! # define DIRENT direct
! # endif
! # endif
#endif
typedef struct arg ARG;
Index: perl.man.3
Prereq: 3.0.1.2
*** perl.man.3.old Thu Dec 21 20:35:59 1989
--- perl.man.3 Thu Dec 21 20:36:01 1989
***************
*** 1,7 ****
''' Beginning of part 3
! ''' $Header: perl.man.3,v 3.0.1.2 89/11/17 15:31:05 lwall Locked $
'''
''' $Log: perl.man.3,v $
''' Revision 3.0.1.2 89/11/17 15:31:05 lwall
''' patch5: fixed some manual typos and indent problems
''' patch5: added warning about print making an array context
--- 1,11 ----
''' Beginning of part 3
! ''' $Header: perl.man.3,v 3.0.1.3 89/12/21 20:10:12 lwall Locked $
'''
''' $Log: perl.man.3,v $
+ ''' Revision 3.0.1.3 89/12/21 20:10:12 lwall
+ ''' patch7: documented that s`pat`repl` does command substitution on replacement
+ ''' patch7: documented that $timeleft from select() is likely not implemented
+ '''
''' Revision 3.0.1.2 89/11/17 15:31:05 lwall
''' patch5: fixed some manual typos and indent problems
''' patch5: added warning about print making an array context
***************
*** 467,473 ****
as a double-quoted string.
Any delimiter may replace the slashes; if single quotes are used, no
interpretation is done on the replacement string (the e modifier overrides
! this, however).
If no string is specified via the =~ or !~ operator,
the $_ string is searched and modified.
(The string specified with =~ must be a scalar variable, an array element,
--- 471,478 ----
as a double-quoted string.
Any delimiter may replace the slashes; if single quotes are used, no
interpretation is done on the replacement string (the e modifier overrides
! this, however); if backquotes are used, the replacement string is a command
! to execute whose output will be used as the actual replacement text.
If no string is specified via the =~ or !~ operator,
the $_ string is searched and modified.
(The string specified with =~ must be a scalar variable, an array element,
***************
*** 582,587 ****
--- 587,594 ----
.fi
Any of the bitmasks can also be undef.
The timeout, if specified, is in seconds, which may be fractional.
+ NOTE: not all implementations are capable of returning the $timeleft.
+ If not, they always return $timeleft equal to the supplied $timeout.
.Ip "setpgrp(PID,PGRP)" 8 4
Sets the current process group for the specified PID, 0 for the current
process.
***************
*** 707,721 ****
.fi
produces the output \*(L'h:i:t:h:e:r:e\*(R'.
.Sp
! The NUM parameter can be used to partially split a line
.nf
($login, $passwd, $remainder) = split(\|/\|:\|/\|, $_, 3);
.fi
! (When assigning to a list, if NUM is omitted, perl supplies a NUM one
larger than the number of variables in the list, to avoid unnecessary work.
! For the list above NUM would have been 4 by default.
In time critical applications it behooves you not to split into
more fields than you really need.)
.Sp
--- 714,728 ----
.fi
produces the output \*(L'h:i:t:h:e:r:e\*(R'.
.Sp
! The LIMIT parameter can be used to partially split a line
.nf
($login, $passwd, $remainder) = split(\|/\|:\|/\|, $_, 3);
.fi
! (When assigning to a list, if LIMIT is omitted, perl supplies a LIMIT one
larger than the number of variables in the list, to avoid unnecessary work.
! For the list above LIMIT would have been 4 by default.
In time critical applications it behooves you not to split into
more fields than you really need.)
.Sp
Index: perl.man.4
Prereq: 3.0.1.3
*** perl.man.4.old Thu Dec 21 20:36:12 1989
--- perl.man.4 Thu Dec 21 20:36:17 1989
***************
*** 1,7 ****
''' Beginning of part 4
! ''' $Header: perl.man.4,v 3.0.1.3 89/11/17 15:32:25 lwall Locked $
'''
''' $Log: perl.man.4,v $
''' Revision 3.0.1.3 89/11/17 15:32:25 lwall
''' patch5: fixed some manual typos and indent problems
''' patch5: clarified difference between $! and $@
--- 1,11 ----
''' Beginning of part 4
! ''' $Header: perl.man.4,v 3.0.1.4 89/12/21 20:12:39 lwall Locked $
'''
''' $Log: perl.man.4,v $
+ ''' Revision 3.0.1.4 89/12/21 20:12:39 lwall
+ ''' patch7: documented that package'filehandle works as well as $package'variable
+ ''' patch7: documented which identifiers are always in package main
+ '''
''' Revision 3.0.1.3 89/11/17 15:32:25 lwall
''' patch5: fixed some manual typos and indent problems
''' patch5: clarified difference between $! and $@
***************
*** 912,920 ****
the \*(L"do FILE\*(R" operator.
You can switch into a package in more than one place; it merely influences
which symbol table is used by the compiler for the rest of that block.
! You can refer to variables in other packages by prefixing the name with
! the package name and a single quote.
If the package name is null, the \*(L"main\*(R" package as assumed.
Eval'ed strings are compiled in the package in which the eval was compiled
in.
(Assignments to $SIG{}, however, assume the signal handler specified is in the
--- 916,936 ----
the \*(L"do FILE\*(R" operator.
You can switch into a package in more than one place; it merely influences
which symbol table is used by the compiler for the rest of that block.
! You can refer to variables and filehandles in other packages by prefixing
! the identifier with the package name and a single quote.
If the package name is null, the \*(L"main\*(R" package as assumed.
+ .PP
+ Only identifiers starting with letters are stored in the packages symbol
+ table.
+ All other symbols are kept in package \*(L"main\*(R".
+ In addition, the identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC
+ and SIG are forced to be in package \*(L"main\*(R", even when used for
+ other purposes than their built-in one.
+ Note also that, if you have a package called \*(L"m\*(R", \*(L"s\*(R"
+ or \*(L"y\*(R", the you can't use the qualified form of an identifier since it
+ will be interpreted instead as a pattern match, a substitution
+ or a translation.
+ .PP
Eval'ed strings are compiled in the package in which the eval was compiled
in.
(Assignments to $SIG{}, however, assume the signal handler specified is in the
***************
*** 978,984 ****
.fi
Note that, even though the subroutine is compiled in package dumpvar, the
! name of the subroutine is qualified so that it's name is inserted into package
\*(L"main\*(R".
.Sh "Style"
Each programmer will, of course, have his or her own preferences in regards
--- 994,1000 ----
.fi
Note that, even though the subroutine is compiled in package dumpvar, the
! name of the subroutine is qualified so that its name is inserted into package
\*(L"main\*(R".
.Sh "Style"
Each programmer will, of course, have his or her own preferences in regards
Index: perl.y
Prereq: 3.0.1.2
*** perl.y.old Thu Dec 21 20:36:27 1989
--- perl.y Thu Dec 21 20:36:30 1989
***************
*** 1,4 ****
! /* $Header: perl.y,v 3.0.1.2 89/11/11 04:49:04 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: perl.y,v 3.0.1.3 89/12/21 20:13:41 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perl.y,v $
+ * Revision 3.0.1.3 89/12/21 20:13:41 lwall
+ * patch7: send() didn't allow a TO argument
+ *
* Revision 3.0.1.2 89/11/11 04:49:04 lwall
* patch2: moved yydebug to where its type doesn't matter
* patch2: !$foo++ was unreasonably illegal
***************
*** 596,602 ****
| FILOP2 '(' handle cexpr ')'
{ $$ = make_op($1, 2, $3, $4, Nullarg); }
| FILOP3 '(' handle csexpr cexpr ')'
! { $$ = make_op($1, 3, $3, $4, $5); }
| FILOP22 '(' handle ',' handle ')'
{ $$ = make_op($1, 2, $3, $5, Nullarg); }
| FILOP4 '(' handle csexpr csexpr cexpr ')'
--- 599,605 ----
| FILOP2 '(' handle cexpr ')'
{ $$ = make_op($1, 2, $3, $4, Nullarg); }
| FILOP3 '(' handle csexpr cexpr ')'
! { $$ = make_op($1, 3, $3, $4, make_list($5)); }
| FILOP22 '(' handle ',' handle ')'
{ $$ = make_op($1, 2, $3, $5, Nullarg); }
| FILOP4 '(' handle csexpr csexpr cexpr ')'
Index: perly.c
Prereq: 3.0.1.2
*** perly.c.old Thu Dec 21 20:36:39 1989
--- perly.c Thu Dec 21 20:36:41 1989
***************
*** 1,4 ****
! char rcsid[] = "$Header: perly.c,v 3.0.1.2 89/11/17 15:34:42 lwall Locked $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! char rcsid[] = "$Header: perly.c,v 3.0.1.3 89/12/21 20:15:41 lwall Locked $\nPatch level: ###\n";
/*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,16 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: perly.c,v $
+ * Revision 3.0.1.3 89/12/21 20:15:41 lwall
+ * patch7: ANSI strerror() is now supported
+ * patch7: errno may now be a macro with an lvalue
+ * patch7: allowed setuid scripts to have a space after #!
+ *
* Revision 3.0.1.2 89/11/17 15:34:42 lwall
* patch5: fixed possible confusion about current effective gid
*
***************
*** 292,300 ****
else
rsfp = fopen(argv[0],"r");
if (rsfp == Nullfp) {
- extern char *sys_errlist[];
- extern int errno;
-
#ifdef DOSUID
#ifndef IAMSUID /* in case script is not readable before setuid */
if (euid && stat(filename,&statbuf) >= 0 &&
--- 297,302 ----
***************
*** 306,312 ****
#endif
#endif
fatal("Can't open perl script \"%s\": %s\n",
! filename, sys_errlist[errno]);
}
str_free(str); /* free -I directories */
--- 308,314 ----
#endif
#endif
fatal("Can't open perl script \"%s\": %s\n",
! filename, strerror(errno));
}
str_free(str); /* free -I directories */
***************
*** 398,404 ****
if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
strnNE(tokenbuf,"#!",2) ) /* required even on Sys V */
fatal("No #! line");
! for (s = tokenbuf+2; !isspace(*s); s++) ;
if (strnNE(s-4,"perl",4)) /* sanity check */
fatal("Not a perl script");
while (*s == ' ' || *s == '\t') s++;
--- 400,408 ----
if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
strnNE(tokenbuf,"#!",2) ) /* required even on Sys V */
fatal("No #! line");
! s = tokenbuf+2;
! if (*s == ' ') s++;
! while (!isspace(*s)) s++;
if (strnNE(s-4,"perl",4)) /* sanity check */
fatal("Not a perl script");
while (*s == ' ' || *s == '\t') s++;
***************
*** 722,728 ****
SPAT *oldspat = curspat;
static char *last_eval = Nullch;
static CMD *last_root = Nullcmd;
! int sp = arglast[0];
tmps_base = tmps_max;
if (curstash != stash) {
--- 726,732 ----
SPAT *oldspat = curspat;
static char *last_eval = Nullch;
static CMD *last_root = Nullcmd;
! VOLATILE int sp = arglast[0];
tmps_base = tmps_max;
if (curstash != stash) {
Index: regexec.c
Prereq: 3.0.1.1
*** regexec.c.old Thu Dec 21 20:36:47 1989
--- regexec.c Thu Dec 21 20:36:49 1989
***************
*** 7,15 ****
* blame Henry for some of the lack of readability.
*/
! /* $Header: regexec.c,v 3.0.1.1 89/11/11 04:52:04 lwall Locked $
*
* $Log: regexec.c,v $
* Revision 3.0.1.1 89/11/11 04:52:04 lwall
* patch2: /\b$foo/ didn't work
*
--- 7,18 ----
* blame Henry for some of the lack of readability.
*/
! /* $Header: regexec.c,v 3.0.1.2 89/12/21 20:16:27 lwall Locked $
*
* $Log: regexec.c,v $
+ * Revision 3.0.1.2 89/12/21 20:16:27 lwall
+ * patch7: certain patterns didn't match correctly at end of string
+ *
* Revision 3.0.1.1 89/11/11 04:52:04 lwall
* patch2: /\b$foo/ didn't work
*
***************
*** 341,347 ****
}
}
else {
! dontbother = minend;
strend -= dontbother;
/* We don't know much -- general case. */
do {
--- 344,351 ----
}
}
else {
! if (minlen)
! dontbother = minlen - 1;
strend -= dontbother;
/* We don't know much -- general case. */
do {
Index: stab.c
Prereq: 3.0.1.2
*** stab.c.old Thu Dec 21 20:37:00 1989
--- stab.c Thu Dec 21 20:37:01 1989
***************
*** 1,4 ****
! /* $Header: stab.c,v 3.0.1.2 89/11/17 15:35:37 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: stab.c,v 3.0.1.3 89/12/21 20:18:40 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,16 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: stab.c,v $
+ * Revision 3.0.1.3 89/12/21 20:18:40 lwall
+ * patch7: ANSI strerror() is now supported
+ * patch7: errno may now be a macro with an lvalue
+ * patch7: in stab.c, sighandler() may now return either void or int
+ *
* Revision 3.0.1.2 89/11/17 15:35:37 lwall
* patch5: sighandler() needed to be static
*
***************
*** 26,34 ****
SIG_NAME,0
};
! extern int errno;
! extern int sys_nerr;
! extern char *sys_errlist[];
STR *
stab_str(str)
--- 31,41 ----
SIG_NAME,0
};
! #ifdef VOIDSIG
! #define handlertype void
! #else
! #define handlertype int
! #endif
STR *
stab_str(str)
***************
*** 143,150 ****
break;
case '!':
str_numset(stab_val(stab), (double)errno);
! str_set(stab_val(stab),
! errno < 0 || errno >= sys_nerr ? "(unknown)" : sys_errlist[errno]);
stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
break;
case '<':
--- 150,156 ----
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 '<':
***************
*** 189,195 ****
STAB *stab = mstr->str_u.str_stab;
char *s;
int i;
! static int sighandler();
switch (mstr->str_rare) {
case 'E':
--- 195,201 ----
STAB *stab = mstr->str_u.str_stab;
char *s;
int i;
! static handlertype sighandler();
switch (mstr->str_rare) {
case 'E':
***************
*** 422,428 ****
return 0;
}
! static int
sighandler(sig)
int sig;
{
--- 428,434 ----
return 0;
}
! static handlertype
sighandler(sig)
int sig;
{
Index: stab.h
Prereq: 3.0
*** stab.h.old Thu Dec 21 20:37:05 1989
--- stab.h Thu Dec 21 20:37:06 1989
***************
*** 1,4 ****
! /* $Header: stab.h,v 3.0 89/10/18 15:23:30 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: stab.h,v 3.0.1.1 89/12/21 20:19:53 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: stab.h,v $
+ * Revision 3.0.1.1 89/12/21 20:19:53 lwall
+ * patch7: in stab.h, added some CRIPPLED_CC support for Microport
+ *
* Revision 3.0 89/10/18 15:23:30 lwall
* 3.0 baseline
*
***************
*** 24,41 ****
--- 27,56 ----
char stbp_flags;
};
+ #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
+ #define MICROPORT
+ #endif
+
#define stab_magic(stab) (((STBP*)(stab->str_ptr))->stbp_magic)
#define stab_val(stab) (((STBP*)(stab->str_ptr))->stbp_val)
#define stab_io(stab) (((STBP*)(stab->str_ptr))->stbp_io)
#define stab_form(stab) (((STBP*)(stab->str_ptr))->stbp_form)
#define stab_xarray(stab) (((STBP*)(stab->str_ptr))->stbp_array)
+ #ifdef MICROPORT /* Microport 2.4 hack */
+ ARRAY *stab_array();
+ #else
#define stab_array(stab) (((STBP*)(stab->str_ptr))->stbp_array ? \
((STBP*)(stab->str_ptr))->stbp_array : \
((STBP*)(aadd(stab)->str_ptr))->stbp_array)
+ #endif
#define stab_xhash(stab) (((STBP*)(stab->str_ptr))->stbp_hash)
+ #ifdef MICROPORT /* Microport 2.4 hack */
+ HASH *stab_hash();
+ #else
#define stab_hash(stab) (((STBP*)(stab->str_ptr))->stbp_hash ? \
((STBP*)(stab->str_ptr))->stbp_hash : \
((STBP*)(hadd(stab)->str_ptr))->stbp_hash)
+ #endif /* Microport 2.4 hack */
#define stab_sub(stab) (((STBP*)(stab->str_ptr))->stbp_sub)
#define stab_lastexpr(stab) (((STBP*)(stab->str_ptr))->stbp_lastexpr)
#define stab_line(stab) (((STBP*)(stab->str_ptr))->stbp_line)
Index: str.c
Prereq: 3.0.1.3
*** str.c.old Thu Dec 21 20:37:11 1989
--- str.c Thu Dec 21 20:37:13 1989
***************
*** 1,4 ****
! /* $Header: str.c,v 3.0.1.3 89/11/17 15:38:23 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: str.c,v 3.0.1.4 89/12/21 20:21:35 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,15 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.c,v $
+ * Revision 3.0.1.4 89/12/21 20:21:35 lwall
+ * patch7: errno may now be a macro with an lvalue
+ * patch7: made nested or recursive foreach work right
+ *
* Revision 3.0.1.3 89/11/17 15:38:23 lwall
* patch5: some machines typedef unchar too
* patch5: substitution on leading components occasionally caused <> corruption
***************
*** 115,122 ****
#endif
}
- extern int errno;
-
char *
str_2ptr(str)
register STR *str;
--- 119,124 ----
***************
*** 212,219 ****
}
else if (sstr->str_nok)
str_numset(dstr,sstr->str_u.str_nval);
! else
dstr->str_pok = dstr->str_nok = 0;
}
str_nset(str,ptr,len)
--- 214,227 ----
}
else if (sstr->str_nok)
str_numset(dstr,sstr->str_u.str_nval);
! else {
! #ifdef STRUCTCOPY
! dstr->str_u = sstr->str_u;
! #else
! dstr->str_u.str_nval = sstr->str_u.str_nval;
! #endif
dstr->str_pok = dstr->str_nok = 0;
+ }
}
str_nset(str,ptr,len)
Index: toke.c
Prereq: 3.0.1.3
*** toke.c.old Thu Dec 21 20:37:22 1989
--- toke.c Thu Dec 21 20:37:27 1989
***************
*** 1,4 ****
! /* $Header: toke.c,v 3.0.1.3 89/11/17 15:43:15 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: toke.c,v 3.0.1.4 89/12/21 20:26:56 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,16 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: toke.c,v $
+ * Revision 3.0.1.4 89/12/21 20:26:56 lwall
+ * patch7: -d switch incompatible with -p or -n
+ * patch7: " ''$foo'' " didn't parse right
+ * patch7: grandfathered m'pat' and s'pat'repl' to not be package qualifiers
+ *
* Revision 3.0.1.3 89/11/17 15:43:15 lwall
* patch5: IBM PC/RT compiler can't deal with UNI() and LOP() macros
* patch5: } misadjusted expection of subsequent term or operator
***************
*** 196,201 ****
--- 201,207 ----
str_cat(linestr,"}");
oldoldbufptr = oldbufptr = s = str_get(linestr);
bufend = linestr->str_ptr + linestr->str_cur;
+ minus_n = minus_p = 0;
goto retry;
}
oldoldbufptr = oldbufptr = s = str_get(linestr);
***************
*** 429,435 ****
while (isascii(*s) && \
(isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
*d++ = *s++; \
! if (d[-1] == '\'') \
d--,s--; \
*d = '\0'; \
d = tokenbuf;
--- 435,441 ----
while (isascii(*s) && \
(isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
*d++ = *s++; \
! while (d[-1] == '\'') \
d--,s--; \
*d = '\0'; \
d = tokenbuf;
***************
*** 758,764 ****
FOP(O_LSTAT);
break;
case 'm': case 'M':
! SNARFWORD;
if (strEQ(d,"m")) {
s = scanpat(s-1);
if (yylval.arg)
--- 764,776 ----
FOP(O_LSTAT);
break;
case 'm': case 'M':
! if (s[1] == '\'') {
! d = "m";
! s++;
! }
! else {
! SNARFWORD;
! }
if (strEQ(d,"m")) {
s = scanpat(s-1);
if (yylval.arg)
***************
*** 849,855 ****
UNI(O_READLINK);
break;
case 's': case 'S':
! SNARFWORD;
if (strEQ(d,"s")) {
s = scansubst(s);
if (yylval.arg)
--- 861,873 ----
UNI(O_READLINK);
break;
case 's': case 'S':
! if (s[1] == '\'') {
! d = "s";
! s++;
! }
! else {
! SNARFWORD;
! }
if (strEQ(d,"s")) {
s = scansubst(s);
if (yylval.arg)
***************
*** 1088,1094 ****
MOP(O_REPEAT);
break;
case 'y': case 'Y':
! SNARFWORD;
if (strEQ(d,"y")) {
s = scantrans(s);
TERM(TRANS);
--- 1106,1118 ----
MOP(O_REPEAT);
break;
case 'y': case 'Y':
! if (s[1] == '\'') {
! d = "y";
! s++;
! }
! else {
! SNARFWORD;
! }
if (strEQ(d,"y")) {
s = scantrans(s);
TERM(TRANS);
***************
*** 1151,1157 ****
while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
*d++ = *s++;
}
! if (d > dest+1 && d[-1] == '\'')
d--,s--;
*d = '\0';
d = dest;
--- 1175,1181 ----
while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
*d++ = *s++;
}
! while (d > dest+1 && d[-1] == '\'')
d--,s--;
*d = '\0';
d = dest;
***************
*** 1675,1681 ****
--- 1699,1709 ----
out:
(void)sprintf(tokenbuf,"%ld",i);
arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
+ #ifdef MICROPORT /* Microport 2.4 hack */
+ { double zz = str_2num(arg[1].arg_ptr.arg_str); }
+ #else
(void)str_2num(arg[1].arg_ptr.arg_str);
+ #endif /* Microport 2.4 hack */
}
break;
case '1': case '2': case '3': case '4': case '5':
***************
*** 1707,1713 ****
--- 1735,1745 ----
}
*d = '\0';
arg[1].arg_ptr.arg_str = str_make(tokenbuf, d - tokenbuf);
+ #ifdef MICROPORT /* Microport 2.4 hack */
+ { double zz = str_2num(arg[1].arg_ptr.arg_str); }
+ #else
(void)str_2num(arg[1].arg_ptr.arg_str);
+ #endif /* Microport 2.4 hack */
break;
case '<':
if (*++s == '<') {
Index: util.c
Prereq: 3.0.1.2
*** util.c.old Thu Dec 21 20:37:37 1989
--- util.c Thu Dec 21 20:37:39 1989
***************
*** 1,4 ****
! /* $Header: util.c,v 3.0.1.2 89/11/17 15:46:35 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: util.c,v 3.0.1.3 89/12/21 20:27:41 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: util.c,v $
+ * Revision 3.0.1.3 89/12/21 20:27:41 lwall
+ * patch7: errno may now be a macro with an lvalue
+ *
* Revision 3.0.1.2 89/11/17 15:46:35 lwall
* patch5: BZERO separate from BCOPY now
* patch5: byteorder now is a hex value
***************
*** 20,26 ****
#include "EXTERN.h"
#include "perl.h"
- #include "errno.h"
#include <signal.h>
#ifdef I_VFORK
--- 23,28 ----
***************
*** 694,701 ****
*curlen = newlen;
}
}
-
- extern int errno;
#ifndef VARARGS
/*VARARGS1*/
--- 696,701 ----
Index: x2p/walk.c
Prereq: 3.0.1.2
*** x2p/walk.c.old Thu Dec 21 20:38:23 1989
--- x2p/walk.c Thu Dec 21 20:38:27 1989
***************
*** 1,4 ****
! /* $Header: walk.c,v 3.0.1.2 89/11/17 15:53:00 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: walk.c,v 3.0.1.3 89/12/21 20:32:35 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: walk.c,v $
+ * Revision 3.0.1.3 89/12/21 20:32:35 lwall
+ * patch7: in a2p, user-defined functions didn't work on some machines
+ *
* Revision 3.0.1.2 89/11/17 15:53:00 lwall
* patch5: on Pyramids, index(s, '}' + 128) doesn't find meta-}
*
***************
*** 1844,1850 ****
case OUSERFUN:
tmp2str = str_new(0);
str_scat(tmp2str,tmpstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
! fixrargs(tmpstr->str_ptr,ops[node+2],0);
str_free(tmpstr);
str_cat(tmp2str,"(");
tmpstr = hfetch(symtab,tmp2str->str_ptr);
--- 1847,1853 ----
case OUSERFUN:
tmp2str = str_new(0);
str_scat(tmp2str,tmpstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
! fixrargs(tmpstr->str_ptr,ops[node+2].ival,0);
str_free(tmpstr);
str_cat(tmp2str,"(");
tmpstr = hfetch(symtab,tmp2str->str_ptr);
More information about the Comp.sources.bugs
mailing list