See patch 7.
-/* $Header: cons.c,v 3.0.1.2 89/11/17 15:08:53 lwall Locked $
+/* $Header: cons.c,v 3.0.1.3 89/12/21 19:20:25 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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
*
/* 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);
+ 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;
}
-/* $Header: doarg.c,v 3.0.1.1 89/11/11 04:17:20 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.2 89/12/21 19:52:15 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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
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,
+ 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;
d += clen;
}
s = spat->spat_regexp->endp[0];
- } while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr,
- TRUE));
+ } 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;
}
else
c = Nullch;
- if (regexec(spat->spat_regexp, s, strend, orig, 1,
+ 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));
}
if (once)
break;
- } while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr,
+ } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
safebase));
str_ncat(dstr,s,strend - s);
str_replace(str,dstr);
-/* $Header: doio.c,v 3.0.1.3 89/11/17 15:13:06 lwall Locked $
+/* $Header: doio.c,v 3.0.1.4 89/12/21 19:55:10 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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()
#include <netdb.h>
#endif
-#include <errno.h>
#ifdef I_PWD
#include <pwd.h>
#endif
#ifdef I_GRP
#include <grp.h>
#endif
-
-extern int errno;
+#ifdef I_UTIME
+#include <utime.h>
+#endif
bool
do_open(stab,name)
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_len;
+ 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 < maxlen) {
+ if (j < growsize) {
if (str->str_pok) {
- str_grow(str,maxlen);
+ str_grow(str,growsize);
s = str_get(str) + j;
- while (++j <= maxlen) {
+ while (++j <= growsize) {
*s++ = '\0';
}
}
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) {
else
tbuf = Null(struct timeval*);
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
nfound = select(
maxlen * 8,
st[sp+1]->str_ptr,
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);
taintproper("Insecure dependency in utime");
#endif
if (items > 2) {
+#ifdef I_UTIME
+ struct utimbuf utbuf;
+#else
struct {
- long atime,
- mtime;
+ long actime;
+ long modtime;
} utbuf;
+#endif
- utbuf.atime = (long)str_gnum(st[++sp]); /* time accessed */
- utbuf.mtime = (long)str_gnum(st[++sp]); /* time modified */
+ 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;
-/* $Header: dolist.c,v 3.0.1.3 89/11/17 15:14:45 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.4 89/12/21 19:58:46 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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,@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
*
if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
- arg_free(spat->spat_runtime); /* it won't change, so */
+ 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)
int oldsave = savestack->ary_fill;
savesptr(&stab_val(defstab));
- if ((arg[1].arg_type & A_MASK) != A_EXPR)
+ 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];
-/* $Header: eval.c,v 3.0.1.2 89/11/17 15:19:34 lwall Locked $
+/* $Header: eval.c,v 3.0.1.3 89/12/21 20:03:05 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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: simplified a too-complex expression for some machine or other
+ * 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
#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)();
char *getlogin();
-extern int sys_nerr;
-extern char *sys_errlist[];
-
int
eval(arg,gimme,sp)
register ARG *arg;
errno = 0;
if (optype > 4)
warn("Too many args on send");
- if (optype >= 4) {
+ 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);
else
tmps = str_get(st[1]);
#ifndef I286
- value = (double) *tmps;
+ value = (double) (*tmps & 255);
#else
anum = (int) *tmps;
- value = (double) anum;
+ value = (double) (anum & 255);
#endif
goto donumset;
case O_SLEEP:
-/* $Header: hash.c,v 3.0.1.1 89/11/11 04:34:18 lwall Locked $
+/* $Header: hash.c,v 3.0.1.2 89/12/21 20:03:39 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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
*
#include "EXTERN.h"
#include "perl.h"
-#include <errno.h>
-
-extern int errno;
STR *
hfetch(tb,key,klen,lval)
-#define PATCHLEVEL 7
+#define PATCHLEVEL 8
-/* $Header: perl.h,v 3.0.1.3 89/11/17 15:28:57 lwall Locked $
+/* $Header: perl.h,v 3.0.1.4 89/12/21 20:07:35 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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>
*
*/
+#ifdef __STDC__
+#define VOLATILE volatile
+#define VREG
+#else
+#define VOLATILE
+#define VREG register
+#endif
+
#define VOIDUSED 1
#include "config.h"
# 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
#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>
+#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>
#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 */
+#if defined(I_DIRENT) && !defined(xenix)
+# include <dirent.h>
+# define DIRENT dirent
#else
-#include <sys/dir.h>
-#endif
-#define DIRENT direct
-#endif
+# 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;
''' Beginning of part 3
-''' $Header: perl.man.3,v 3.0.1.2 89/11/17 15:31:05 lwall Locked $
+''' $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
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).
+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,
.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.
.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
+The LIMIT 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
+(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 NUM would have been 4 by default.
+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
''' Beginning of part 4
-''' $Header: perl.man.4,v 3.0.1.3 89/11/17 15:32:25 lwall Locked $
+''' $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 $@
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.
+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
.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
+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
-/* $Header: perl.y,v 3.0.1.2 89/11/11 04:49:04 lwall Locked $
+/* $Header: perl.y,v 3.0.1.3 89/12/21 20:13:41 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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
| FILOP2 '(' handle cexpr ')'
{ $$ = make_op($1, 2, $3, $4, Nullarg); }
| FILOP3 '(' handle csexpr cexpr ')'
- { $$ = make_op($1, 3, $3, $4, $5); }
+ { $$ = make_op($1, 3, $3, $4, make_list($5)); }
| FILOP22 '(' handle ',' handle ')'
{ $$ = make_op($1, 2, $3, $5, Nullarg); }
| FILOP4 '(' handle csexpr csexpr cexpr ')'
-char rcsid[] = "$Header: perly.c,v 3.0.1.2 89/11/17 15:34:42 lwall Locked $\nPatch level: ###\n";
+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
*
* 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
*
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 &&
#endif
#endif
fatal("Can't open perl script \"%s\": %s\n",
- filename, sys_errlist[errno]);
+ filename, strerror(errno));
}
str_free(str); /* free -I directories */
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++) ;
+ 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++;
SPAT *oldspat = curspat;
static char *last_eval = Nullch;
static CMD *last_root = Nullcmd;
- int sp = arglast[0];
+ VOLATILE int sp = arglast[0];
tmps_base = tmps_max;
if (curstash != stash) {
* 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 $
+/* $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
*
}
}
else {
- dontbother = minend;
+ if (minlen)
+ dontbother = minlen - 1;
strend -= dontbother;
/* We don't know much -- general case. */
do {
-/* $Header: stab.c,v 3.0.1.2 89/11/17 15:35:37 lwall Locked $
+/* $Header: stab.c,v 3.0.1.3 89/12/21 20:18:40 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.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
*
SIG_NAME,0
};
-extern int errno;
-extern int sys_nerr;
-extern char *sys_errlist[];
+#ifdef VOIDSIG
+#define handlertype void
+#else
+#define handlertype int
+#endif
STR *
stab_str(str)
break;
case '!':
str_numset(stab_val(stab), (double)errno);
- str_set(stab_val(stab),
- errno < 0 || errno >= sys_nerr ? "(unknown)" : sys_errlist[errno]);
+ str_set(stab_val(stab), strerror(errno));
stab_val(stab)->str_nok = 1; /* what a wonderful hack! */
break;
case '<':
STAB *stab = mstr->str_u.str_stab;
char *s;
int i;
- static int sighandler();
+ static handlertype sighandler();
switch (mstr->str_rare) {
case 'E':
return 0;
}
-static int
+static handlertype
sighandler(sig)
int sig;
{
-/* $Header: stab.h,v 3.0 89/10/18 15:23:30 lwall Locked $
+/* $Header: stab.h,v 3.0.1.1 89/12/21 20:19:53 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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
*
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)
-/* $Header: str.c,v 3.0.1.3 89/11/17 15:38:23 lwall Locked $
+/* $Header: str.c,v 3.0.1.4 89/12/21 20:21:35 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.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
#endif
}
-extern int errno;
-
char *
str_2ptr(str)
register STR *str;
}
else if (sstr->str_nok)
str_numset(dstr,sstr->str_u.str_nval);
- else
+ 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)
-/* $Header: toke.c,v 3.0.1.3 89/11/17 15:43:15 lwall Locked $
+/* $Header: toke.c,v 3.0.1.4 89/12/21 20:26:56 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.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
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);
while (isascii(*s) && \
(isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
*d++ = *s++; \
- if (d[-1] == '\'') \
+ while (d[-1] == '\'') \
d--,s--; \
*d = '\0'; \
d = tokenbuf;
FOP(O_LSTAT);
break;
case 'm': case 'M':
- SNARFWORD;
+ if (s[1] == '\'') {
+ d = "m";
+ s++;
+ }
+ else {
+ SNARFWORD;
+ }
if (strEQ(d,"m")) {
s = scanpat(s-1);
if (yylval.arg)
UNI(O_READLINK);
break;
case 's': case 'S':
- SNARFWORD;
+ if (s[1] == '\'') {
+ d = "s";
+ s++;
+ }
+ else {
+ SNARFWORD;
+ }
if (strEQ(d,"s")) {
s = scansubst(s);
if (yylval.arg)
MOP(O_REPEAT);
break;
case 'y': case 'Y':
- SNARFWORD;
+ if (s[1] == '\'') {
+ d = "y";
+ s++;
+ }
+ else {
+ SNARFWORD;
+ }
if (strEQ(d,"y")) {
s = scantrans(s);
TERM(TRANS);
while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
*d++ = *s++;
}
- if (d > dest+1 && d[-1] == '\'')
+ while (d > dest+1 && d[-1] == '\'')
d--,s--;
*d = '\0';
d = dest;
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':
}
*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 == '<') {
-/* $Header: util.c,v 3.0.1.2 89/11/17 15:46:35 lwall Locked $
+/* $Header: util.c,v 3.0.1.3 89/12/21 20:27:41 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.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
#include "EXTERN.h"
#include "perl.h"
-#include "errno.h"
#include <signal.h>
#ifdef I_VFORK
}
}
-extern int errno;
-
#ifndef VARARGS
/*VARARGS1*/
mess(pat,a1,a2,a3,a4)
-/* $Header: walk.c,v 3.0.1.2 89/11/17 15:53:00 lwall Locked $
+/* $Header: walk.c,v 3.0.1.3 89/12/21 20:32:35 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* 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-}
*
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);
+ fixrargs(tmpstr->str_ptr,ops[node+2].ival,0);
str_free(tmpstr);
str_cat(tmp2str,"(");
tmpstr = hfetch(symtab,tmp2str->str_ptr);
projects / p5sagit/p5-mst-13.2.git / commitdiff