perl 3.0 patch #27
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Sat Aug 11 07:25:31 AEST 1990
System: perl version 3.0
Patch #: 27
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:
Configure -d
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: 26
1c1
< #define PATCHLEVEL 26
---
> #define PATCHLEVEL 27
Index: usub/usersub.c
*** usub/usersub.c.old Thu Aug 9 06:02:07 1990
--- usub/usersub.c Thu Aug 9 06:02:08 1990
***************
*** 0 ****
--- 1,17 ----
+ /* $Header: usersub.c,v 3.0.1.1 90/08/09 04:06:10 lwall Locked $
+ *
+ * $Log: usersub.c,v $
+ * Revision 3.0.1.1 90/08/09 04:06:10 lwall
+ * patch19: Initial revision
+ *
+ */
+
+ #include "EXTERN.h"
+ #include "perl.h"
+
+ int
+ userinit()
+ {
+ init_curses();
+ }
+
Index: usersub.c
*** usersub.c.old Thu Aug 9 06:06:32 1990
--- usersub.c Thu Aug 9 06:06:33 1990
***************
*** 0 ****
--- 1,184 ----
+ /* $Header: usersub.c,v 3.0.1.1 90/08/09 05:40:45 lwall Locked $
+ *
+ * This file contains stubs for routines that the user may define to
+ * set up glue routines for C libraries or to decrypt encrypted scripts
+ * for execution.
+ *
+ * $Log: usersub.c,v $
+ * Revision 3.0.1.1 90/08/09 05:40:45 lwall
+ * patch19: Initial revision
+ *
+ */
+
+ #include "EXTERN.h"
+ #include "perl.h"
+
+ userinit()
+ {
+ return 0;
+ }
+
+ /*
+ * The following is supplied by John MacDonald as a means of decrypting
+ * and executing (presumably proprietary) scripts that have been encrypted
+ * by a (presumably secret) method. The idea is that you supply your own
+ * routine in place of cryptfilter (which is purposefully a very weak
+ * encryption). If an encrypted script is detected, a process is forked
+ * off to run the cryptfilter routine as input to perl.
+ */
+
+ #ifdef CRYPTSCRIPT
+
+ #include <signal.h>
+ #ifdef I_VFORK
+ #include <vfork.h>
+ #endif
+
+ #define CRYPT_MAGIC_1 0xfb
+ #define CRYPT_MAGIC_2 0xf1
+
+ cryptfilter( fil )
+ FILE * fil;
+ {
+ int ch;
+
+ while( (ch = getc( fil )) != EOF ) {
+ putchar( (ch ^ 0x80) );
+ }
+ }
+
+ #ifndef MSDOS
+ static FILE *lastpipefile;
+ static int pipepid;
+
+ #ifdef VOIDSIG
+ # define VOID void
+ #else
+ # define VOID int
+ #endif
+
+ FILE *
+ mypfiopen(fil,func) /* open a pipe to function call for input */
+ FILE *fil;
+ VOID (*func)();
+ {
+ int p[2];
+ STR *str;
+
+ if (pipe(p) < 0) {
+ fclose( fil );
+ fatal("Can't get pipe for decrypt");
+ }
+
+ /* make sure that the child doesn't get anything extra */
+ fflush(stdout);
+ fflush(stderr);
+
+ while ((pipepid = fork()) < 0) {
+ if (errno != EAGAIN) {
+ close(p[0]);
+ close(p[1]);
+ fclose( fil );
+ fatal("Can't fork for decrypt");
+ }
+ sleep(5);
+ }
+ if (pipepid == 0) {
+ close(p[0]);
+ if (p[1] != 1) {
+ dup2(p[1], 1);
+ close(p[1]);
+ }
+ (*func)(fil);
+ fflush(stdout);
+ fflush(stderr);
+ _exit(0);
+ }
+ close(p[1]);
+ fclose(fil);
+ str = afetch(pidstatary,p[0],TRUE);
+ str_numset(str,(double)pipepid);
+ str->str_cur = 0;
+ return fdopen(p[0], "r");
+ }
+
+ cryptswitch()
+ {
+ int ch;
+ #ifdef STDSTDIO
+ /* cheat on stdio if possible */
+ if (rsfp->_cnt > 0 && (*rsfp->_ptr & 0xff) != CRYPT_MAGIC_1)
+ return;
+ #endif
+ ch = getc(rsfp);
+ if (ch == CRYPT_MAGIC_1) {
+ if (getc(rsfp) == CRYPT_MAGIC_2) {
+ rsfp = mypfiopen( rsfp, cryptfilter );
+ preprocess = 1; /* force call to pclose when done */
+ }
+ else
+ fatal( "bad encryption format" );
+ }
+ else
+ ungetc(ch,rsfp);
+ }
+
+ FILE *
+ cryptopen(cmd) /* open a (possibly encrypted) program for input */
+ char *cmd;
+ {
+ FILE *fil = fopen( cmd, "r" );
+
+ lastpipefile = Nullfp;
+ pipepid = 0;
+
+ if( fil ) {
+ int ch = getc( fil );
+ int lines = 0;
+ int chars = 0;
+
+ /* Search for the magic cookie that starts the encrypted script,
+ ** while still allowing a few lines of unencrypted text to let
+ ** '#!' and the nih hack both continue to work. (These lines
+ ** will end up being ignored.)
+ */
+ while( ch != CRYPT_MAGIC_1 && ch != EOF && lines < 5 && chars < 300 ) {
+ if( ch == '\n' )
+ ++lines;
+ ch = getc( fil );
+ ++chars;
+ }
+
+ if( ch == CRYPT_MAGIC_1 ) {
+ if( (ch = getc( fil ) ) == CRYPT_MAGIC_2 ) {
+ if( perldb ) fatal("can't debug an encrypted script");
+ /* we found it, decrypt the rest of the file */
+ fil = mypfiopen( fil, cryptfilter );
+ return( lastpipefile = fil );
+ } else
+ /* if its got MAGIC 1 without MAGIC 2, too bad */
+ fatal( "bad encryption format" );
+ }
+
+ /* this file is not encrypted - rewind and process it normally */
+ rewind( fil );
+ }
+
+ return( fil );
+ }
+
+ VOID
+ cryptclose(fil)
+ FILE *fil;
+ {
+ if( fil == Nullfp )
+ return;
+
+ if( fil == lastpipefile )
+ mypclose( fil );
+ else
+ fclose( fil );
+ }
+ #endif /* !MSDOS */
+
+ #endif /* CRYPTSCRIPT */
Index: util.c
Prereq: 3.0.1.5
*** util.c.old Thu Aug 9 06:06:41 1990
--- util.c Thu Aug 9 06:06:45 1990
***************
*** 1,4 ****
! /* $Header: util.c,v 3.0.1.5 90/03/27 16:35:13 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: util.c,v 3.0.1.6 90/08/09 05:44:55 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: util.c,v $
+ * Revision 3.0.1.6 90/08/09 05:44:55 lwall
+ * patch19: fixed double include of <signal.h>
+ * patch19: various MSDOS and OS/2 patches folded in
+ * patch19: open(STDOUT,"|command") left wrong descriptor attached to STDOUT
+ *
* Revision 3.0.1.5 90/03/27 16:35:13 lwall
* patch16: MSDOS support
* patch16: support for machines that can't cast negative floats to unsigned ints
***************
*** 34,40 ****
--- 39,48 ----
#include "EXTERN.h"
#include "perl.h"
+
+ #ifndef NSIG
#include <signal.h>
+ #endif
#ifdef I_VFORK
# include <vfork.h>
***************
*** 61,71 ****
--- 69,89 ----
char *
safemalloc(size)
+ #ifdef MSDOS
+ unsigned long size;
+ #else
MEM_SIZE size;
+ #endif /* MSDOS */
{
char *ptr;
char *malloc();
+ #ifdef MSDOS
+ if (size > 0xffff) {
+ fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH;
+ exit(1);
+ }
+ #endif /* MSDOS */
ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
#ifdef DEBUGGING
# ifndef I286
***************
*** 93,103 ****
--- 111,131 ----
char *
saferealloc(where,size)
char *where;
+ #ifndef MSDOS
MEM_SIZE size;
+ #else
+ unsigned long size;
+ #endif /* MSDOS */
{
char *ptr;
char *realloc();
+ #ifdef MSDOS
+ if (size > 0xffff) {
+ fprintf(stderr, "Reallocation too large: %lx\n", size) FLUSH;
+ exit(1);
+ }
+ #endif /* MSDOS */
if (!where)
fatal("Null realloc");
ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
***************
*** 204,210 ****
char *
cpytill(to,from,fromend,delim,retlen)
! register char *to, *from;
register char *fromend;
register int delim;
int *retlen;
--- 232,239 ----
char *
cpytill(to,from,fromend,delim,retlen)
! register char *to;
! register char *from;
register char *fromend;
register int delim;
int *retlen;
***************
*** 406,412 ****
int rarest = 0;
int frequency = 256;
! str_grow(str,len+258);
#ifndef lint
table = (unsigned char*)(str->str_ptr + len + 1);
#else
--- 435,441 ----
int rarest = 0;
int frequency = 256;
! Str_Grow(str,len+258);
#ifndef lint
table = (unsigned char*)(str->str_ptr + len + 1);
#else
***************
*** 521,533 ****
#else
table = Null(unsigned char*);
#endif
! s = big + --littlelen;
oldlittle = little = table - 2;
if (littlestr->str_pok & SP_CASEFOLD) { /* case insensitive? */
while (s < bigend) {
top1:
if (tmp = table[*s]) {
! s += tmp;
}
else {
tmp = littlelen; /* less expensive than calling strncmp() */
--- 550,573 ----
#else
table = Null(unsigned char*);
#endif
! if (--littlelen >= bigend - big)
! return Nullch;
! s = big + littlelen;
oldlittle = little = table - 2;
if (littlestr->str_pok & SP_CASEFOLD) { /* case insensitive? */
while (s < bigend) {
top1:
if (tmp = table[*s]) {
! #ifdef POINTERRIGOR
! if (bigend - s > tmp) {
! s += tmp;
! goto top1;
! }
! #else
! if ((s += tmp) < bigend)
! goto top1;
! #endif
! return Nullch;
}
else {
tmp = littlelen; /* less expensive than calling strncmp() */
***************
*** 551,557 ****
while (s < bigend) {
top2:
if (tmp = table[*s]) {
! s += tmp;
}
else {
tmp = littlelen; /* less expensive than calling strncmp() */
--- 591,606 ----
while (s < bigend) {
top2:
if (tmp = table[*s]) {
! #ifdef POINTERRIGOR
! if (bigend - s > tmp) {
! s += tmp;
! goto top2;
! }
! #else
! if ((s += tmp) < bigend)
! goto top2;
! #endif
! return Nullch;
}
else {
tmp = littlelen; /* less expensive than calling strncmp() */
***************
*** 723,731 ****
(void)sprintf(s,pat,a1,a2,a3,a4);
s += strlen(s);
if (s[-1] != '\n') {
! if (line) {
! (void)sprintf(s," at %s line %ld",
! in_eval?filename:origfilename, (long)line);
s += strlen(s);
}
if (last_in_stab &&
--- 772,779 ----
(void)sprintf(s,pat,a1,a2,a3,a4);
s += strlen(s);
if (s[-1] != '\n') {
! if (curcmd->c_line) {
! (void)sprintf(s," at %s line %ld", filename, (long)curcmd->c_line);
s += strlen(s);
}
if (last_in_stab &&
***************
*** 821,829 ****
s += strlen(s);
if (s[-1] != '\n') {
! if (line) {
! (void)sprintf(s," at %s line %ld",
! in_eval?filename:origfilename, (long)line);
s += strlen(s);
}
if (last_in_stab &&
--- 869,876 ----
s += strlen(s);
if (s[-1] != '\n') {
! if (curcmd->c_line) {
! (void)sprintf(s," at %s line %ld", filename, (long)curcmd->c_line);
s += strlen(s);
}
if (last_in_stab &&
***************
*** 946,952 ****
--- 993,1005 ----
New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
/* this may or may not be in */
/* the old environ structure */
+ #ifndef MSDOS
(void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
+ #else
+ /* MS-DOS requires environment variable names to be in uppercase */
+ strcpy(environ[i],nam); strupr(environ[i],nam);
+ (void)sprintf(environ[i] + strlen(nam),"=%s",val);
+ #endif /* MSDOS */
}
int
***************
*** 1176,1182 ****
--- 1229,1241 ----
#undef THIS
#undef THAT
}
+ do_execfree(); /* free any memory malloced by child on vfork */
close(p[that]);
+ if (p[that] < p[this]) {
+ dup2(p[this], p[that]);
+ close(p[this]);
+ p[this] = p[that];
+ }
str = afetch(pidstatary,p[this],TRUE);
str_numset(str,(double)pid);
str->str_cur = 0;
***************
*** 1206,1212 ****
int oldfd;
int newfd;
{
! int fdtmp[10];
int fdx = 0;
int fd;
--- 1265,1275 ----
int oldfd;
int newfd;
{
! #if defined(FCNTL) && defined(F_DUPFD)
! close(newfd);
! fcntl(oldfd, F_DUPFD, newfd);
! #else
! int fdtmp[20];
int fdx = 0;
int fd;
***************
*** 1215,1220 ****
--- 1278,1284 ----
fdtmp[fdx++] = fd;
while (fdx > 0)
close(fdtmp[--fdx]);
+ #endif
}
#endif
***************
*** 1223,1229 ****
mypclose(ptr)
FILE *ptr;
{
- register int result;
#ifdef VOIDSIG
void (*hstat)(), (*istat)(), (*qstat)();
#else
--- 1287,1292 ----
***************
*** 1248,1253 ****
--- 1311,1318 ----
if (pid < 0) /* already exited? */
status = str->str_cur;
else {
+ int result;
+
while ((result = wait(&status)) != pid && result >= 0)
pidgone(result,status);
if (result < 0)
***************
*** 1336,1338 ****
--- 1401,1445 ----
return (unsigned long)along;
}
#endif
+
+ #ifndef RENAME
+ int
+ same_dirent(a,b)
+ char *a;
+ char *b;
+ {
+ char *fa = rindex(a,'/');
+ char *fb = rindex(b,'/');
+ struct stat tmpstatbuf1;
+ struct stat tmpstatbuf2;
+ #ifndef MAXPATHLEN
+ #define MAXPATHLEN 1024
+ #endif
+ char tmpbuf[MAXPATHLEN+1];
+
+ if (fa)
+ fa++;
+ else
+ fa = a;
+ if (fb)
+ fb++;
+ else
+ fb = b;
+ if (strNE(a,b))
+ return FALSE;
+ if (fa == a)
+ strcpy(tmpbuf,".")
+ else
+ strncpy(tmpbuf, a, fa - a);
+ if (stat(tmpbuf, &tmpstatbuf1) < 0)
+ return FALSE;
+ if (fb == b)
+ strcpy(tmpbuf,".")
+ else
+ strncpy(tmpbuf, b, fb - b);
+ if (stat(tmpbuf, &tmpstatbuf2) < 0)
+ return FALSE;
+ return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
+ tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
+ }
+ #endif /* !RENAME */
Index: lib/validate.pl
Prereq: 3.0
*** lib/validate.pl.old Thu Aug 9 06:01:21 1990
--- lib/validate.pl Thu Aug 9 06:01:22 1990
***************
*** 1,4 ****
! ;# $Header: validate.pl,v 3.0 89/10/18 15:20:04 lwall Locked $
;# The validate routine takes a single multiline string consisting of
;# lines containing a filename plus a file test to try on it. (The
--- 1,4 ----
! ;# $Header: validate.pl,v 3.0.1.1 90/08/09 04:03:10 lwall Locked $
;# The validate routine takes a single multiline string consisting of
;# lines containing a filename plus a file test to try on it. (The
***************
*** 17,22 ****
--- 17,23 ----
;# The routine returns the number of warnings issued.
;# Usage:
+ ;# require "validate.pl";
;# $warnings += do validate('
;# /vmunix -e || die
;# /boot -e || die
Index: x2p/walk.c
Prereq: 3.0.1.4
*** x2p/walk.c.old Thu Aug 9 06:07:19 1990
--- x2p/walk.c Thu Aug 9 06:07:27 1990
***************
*** 1,4 ****
! /* $Header: walk.c,v 3.0.1.4 90/03/01 10:32:45 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: walk.c,v 3.0.1.5 90/08/09 05:55:01 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: walk.c,v $
+ * Revision 3.0.1.5 90/08/09 05:55:01 lwall
+ * patch19: a2p emited local($_) without a semicolon
+ * patch19: a2p didn't make explicit split on whitespace skip leading whitespace
+ * patch19: foreach on a normal array was iterating on values instead of indexes
+ *
* Revision 3.0.1.4 90/03/01 10:32:45 lwall
* patch9: a2p didn't put a $ on ExitValue
*
***************
*** 182,188 ****
str_cat(str," $FNRbase = $. if eof;\n");
}
if (len & 1)
! str_cat(str," local($_)\n");
if (len & 2)
str_cat(str,
" if ($getline_ok = (($_ = <$fh>) ne ''))");
--- 187,193 ----
str_cat(str," $FNRbase = $. if eof;\n");
}
if (len & 1)
! str_cat(str," local($_);\n");
if (len & 2)
str_cat(str,
" if ($getline_ok = (($_ = <$fh>) ne ''))");
***************
*** 327,332 ****
--- 332,347 ----
str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,prec));
str_free(fstr);
break;
+ case OCOND:
+ prec = P_COND;
+ str = walk(1,level,ops[node+1].ival,&numarg,prec);
+ str_cat(str," ? ");
+ str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+ str_free(fstr);
+ str_cat(str," : ");
+ str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1));
+ str_free(fstr);
+ break;
case OCPAREN:
str = str_new(0);
str_set(str,"(");
***************
*** 679,684 ****
--- 694,701 ----
i = fstr->str_ptr[1] & 127;
if (index("*+?.[]()|^$\\",i))
sprintf(tokenbuf,"/\\%c/",i);
+ else if (i = ' ')
+ sprintf(tokenbuf,"' '");
else
sprintf(tokenbuf,"/%c/",i);
str_cat(str,tokenbuf);
***************
*** 698,704 ****
str_cat(str,", ");
str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_COMMA+1));
str_free(fstr);
! str_cat(str,", 999)");
if (useval) {
str_cat(str,")");
}
--- 715,721 ----
str_cat(str,", ");
str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_COMMA+1));
str_free(fstr);
! str_cat(str,", 9999)");
if (useval) {
str_cat(str,")");
}
***************
*** 1441,1447 ****
tmp2str = hfetch(symtab,str->str_ptr);
if (tmp2str && atoi(tmp2str->str_ptr)) {
sprintf(tokenbuf,
! "foreach %s (@%s) ",
s,
d+1);
}
--- 1458,1464 ----
tmp2str = hfetch(symtab,str->str_ptr);
if (tmp2str && atoi(tmp2str->str_ptr)) {
sprintf(tokenbuf,
! "foreach %s ($[ .. $#%s) ",
s,
d+1);
}
***************
*** 1587,1599 ****
str_cat(str,tokenbuf);
}
if (const_FS) {
! sprintf(tokenbuf," = split(/[%c\\n]/, $_, 999);\n",const_FS);
str_cat(str,tokenbuf);
}
else if (saw_FS)
! str_cat(str," = split($FS, $_, 999);\n");
else
! str_cat(str," = split(' ', $_, 999);\n");
tab(str,level);
}
--- 1604,1616 ----
str_cat(str,tokenbuf);
}
if (const_FS) {
! sprintf(tokenbuf," = split(/[%c\\n]/, $_, 9999);\n",const_FS);
str_cat(str,tokenbuf);
}
else if (saw_FS)
! str_cat(str," = split($FS, $_, 9999);\n");
else
! str_cat(str," = split(' ', $_, 9999);\n");
tab(str,level);
}
Index: dolist.c
Prereq: 3.0.1.7
*** dolist.c.old Thu Aug 9 05:58:09 1990
--- dolist.c Thu Aug 9 05:58:14 1990
***************
*** 1,4 ****
! /* $Header: dolist.c,v 3.0.1.7 90/03/27 15:48:42 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: dolist.c,v 3.0.1.8 90/08/09 03:15:56 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,22 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.8 90/08/09 03:15:56 lwall
+ * patch19: certain kinds of matching cause "panic: hint"
+ * patch19: $' broke on embedded nulls
+ * patch19: split on /\s+/, /^/ and ' ' is now special cased for speed
+ * patch19: split on /x/i didn't work
+ * patch19: couldn't unpack an 'A' or 'a' field in a scalar context
+ * patch19: unpack called bcopy on each character of a C/c field
+ * patch19: pack/unpack know about uudecode lines
+ * patch19: fixed sort on undefined strings and sped up slightly
+ * patch19: each and keys returned garbage on null key in DBM file
+ *
* Revision 3.0.1.7 90/03/27 15:48:42 lwall
* patch16: MSDOS support
* patch16: use of $`, $& or $' sometimes causes memory leakage
***************
*** 69,75 ****
--- 80,88 ----
register char *s = str_get(st[sp]);
char *strend = s + st[sp]->str_cur;
STR *tmpstr;
+ char *myhint = hint;
+ hint = Nullch;
if (!spat) {
if (gimme == G_ARRAY)
return --sp;
***************
*** 106,112 ****
if (spat->spat_regexp)
regfree(spat->spat_regexp);
spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
! spat->spat_flags & SPAT_FOLD,1);
if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
--- 119,125 ----
if (spat->spat_regexp)
regfree(spat->spat_regexp);
spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
! spat->spat_flags & SPAT_FOLD);
if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
if (spat->spat_flags & SPAT_KEEP) {
***************
*** 148,158 ****
if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
t = s;
! if (hint) {
! if (hint < s || hint > strend)
fatal("panic: hint in do_match");
! s = hint;
! hint = Nullch;
if (spat->spat_regexp->regback >= 0) {
s -= spat->spat_regexp->regback;
if (s < t)
--- 161,170 ----
if (!*spat->spat_regexp->precomp && lastspat)
spat = lastspat;
t = s;
! if (myhint) {
! if (myhint < s || myhint > strend)
fatal("panic: hint in do_match");
! s = myhint;
if (spat->spat_regexp->regback >= 0) {
s -= spat->spat_regexp->regback;
if (s < t)
***************
*** 256,261 ****
--- 268,274 ----
if (spat->spat_regexp->subbase)
Safefree(spat->spat_regexp->subbase);
tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
+ spat->spat_regexp->subend = tmps + (strend-t);
tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
curspat = spat;
***************
*** 317,323 ****
if (spat->spat_regexp)
regfree(spat->spat_regexp);
spat->spat_regexp = regcomp(m,m+dstr->str_cur,
! spat->spat_flags & SPAT_FOLD,1);
if (spat->spat_flags & SPAT_KEEP ||
(spat->spat_runtime->arg_type == O_ITEM &&
(spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
--- 330,336 ----
if (spat->spat_regexp)
regfree(spat->spat_regexp);
spat->spat_regexp = regcomp(m,m+dstr->str_cur,
! spat->spat_flags & SPAT_FOLD);
if (spat->spat_flags & SPAT_KEEP ||
(spat->spat_runtime->arg_type == O_ITEM &&
(spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
***************
*** 350,361 ****
}
if (!limit)
limit = maxiters + 2;
! if (spat->spat_short) {
i = spat->spat_short->str_cur;
if (i == 1) {
i = *spat->spat_short->str_ptr;
while (--limit) {
! for (m = s; m < strend && *m != i; m++) ;
if (m >= strend)
break;
if (realarray)
--- 363,415 ----
}
if (!limit)
limit = maxiters + 2;
! if (strEQ("\\s+",spat->spat_regexp->precomp)) {
! while (--limit) {
! for (m = s; m < strend && !isspace(*m); m++) ;
! if (m >= strend)
! break;
! if (realarray)
! dstr = Str_new(30,m-s);
! else
! dstr = str_static(&str_undef);
! str_nset(dstr,s,m-s);
! (void)astore(ary, ++sp, dstr);
! for (s = m + 1; s < strend && isspace(*s); s++) ;
! }
! }
! else if (strEQ("^",spat->spat_regexp->precomp)) {
! while (--limit) {
! for (m = s; m < strend && *m != '\n'; m++) ;
! m++;
! if (m >= strend)
! break;
! if (realarray)
! dstr = Str_new(30,m-s);
! else
! dstr = str_static(&str_undef);
! str_nset(dstr,s,m-s);
! (void)astore(ary, ++sp, dstr);
! s = m;
! }
! }
! else if (spat->spat_short) {
i = spat->spat_short->str_cur;
if (i == 1) {
+ int fold = (spat->spat_flags & SPAT_FOLD);
+
i = *spat->spat_short->str_ptr;
+ if (fold && isupper(i))
+ i = tolower(i);
while (--limit) {
! if (fold) {
! for ( m = s;
! m < strend && *m != i &&
! (!isupper(*m) || tolower(*m) != i);
! m++)
! ;
! }
! else
! for (m = s; m < strend && *m != i; m++) ;
if (m >= strend)
break;
if (realarray)
***************
*** 434,440 ****
iters++;
}
else {
! #ifndef I286
while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
iters--,sp--;
#else
--- 488,494 ----
iters++;
}
else {
! #ifndef I286x
while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
iters--,sp--;
#else
***************
*** 486,491 ****
--- 540,546 ----
register char *pat = str_get(st[sp++]);
register char *s = str_get(st[sp]);
char *strend = s + st[sp--]->str_cur;
+ char *strbeg = s;
register char *patend = pat + st[sp]->str_cur;
int datumtype;
register int len;
***************
*** 500,533 ****
unsigned int auint;
unsigned long aulong;
char *aptr;
if (gimme != G_ARRAY) { /* arrange to do first one only */
! patend = pat+1;
! if (*pat == 'a' || *pat == 'A') {
! while (isdigit(*patend))
patend++;
}
}
sp--;
while (pat < patend) {
datumtype = *pat++;
! if (isdigit(*pat)) {
len = *pat++ - '0';
while (isdigit(*pat))
len = (len * 10) + (*pat++ - '0');
}
else
! len = 1;
switch(datumtype) {
default:
break;
case 'x':
s += len;
break;
case 'A':
case 'a':
! if (s + len > strend)
len = strend - s;
str = Str_new(35,len);
str_nset(str,s,len);
s += len;
--- 555,624 ----
unsigned int auint;
unsigned long aulong;
char *aptr;
+ float afloat;
+ double adouble;
+ int checksum = 0;
+ unsigned long culong;
+ double cdouble;
if (gimme != G_ARRAY) { /* arrange to do first one only */
! for (patend = pat; !isalpha(*patend); patend++);
! if (*patend == 'a' || *patend == 'A' || *pat == '%') {
! patend++;
! while (isdigit(*patend) || *patend == '*')
patend++;
}
+ else
+ patend++;
}
sp--;
while (pat < patend) {
+ reparse:
datumtype = *pat++;
! if (pat >= patend)
! len = 1;
! else if (*pat == '*')
! len = strend - strbeg; /* long enough */
! else if (isdigit(*pat)) {
len = *pat++ - '0';
while (isdigit(*pat))
len = (len * 10) + (*pat++ - '0');
}
else
! len = (datumtype != '@');
switch(datumtype) {
default:
break;
+ case '%':
+ if (len == 1 && pat[-1] != '1')
+ len = 16;
+ checksum = len;
+ culong = 0;
+ cdouble = 0;
+ if (pat < patend)
+ goto reparse;
+ break;
+ case '@':
+ if (len > strend - s)
+ fatal("@ outside of string");
+ s = strbeg + len;
+ break;
+ case 'X':
+ if (len > s - strbeg)
+ fatal("X outside of string");
+ s -= len;
+ break;
case 'x':
+ if (len > strend - s)
+ fatal("x outside of string");
s += len;
break;
case 'A':
case 'a':
! if (len > strend - s)
len = strend - s;
+ if (checksum)
+ goto uchar_checksum;
str = Str_new(35,len);
str_nset(str,s,len);
s += len;
***************
*** 543,669 ****
(void)astore(stack, ++sp, str_2static(str));
break;
case 'c':
! while (len-- > 0) {
! if (s + sizeof(char) > strend)
! achar = 0;
! else {
! bcopy(s,(char*)&achar,sizeof(char));
! s += sizeof(char);
}
- str = Str_new(36,0);
- aint = achar;
- if (aint >= 128) /* fake up signed chars */
- aint -= 256;
- str_numset(str,(double)aint);
- (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'C':
! while (len-- > 0) {
! if (s + sizeof(unsigned char) > strend)
! auchar = 0;
! else {
! bcopy(s,(char*)&auchar,sizeof(unsigned char));
! s += sizeof(unsigned char);
}
- str = Str_new(37,0);
- auint = auchar; /* some can't cast uchar to double */
- str_numset(str,(double)auint);
- (void)astore(stack, ++sp, str_2static(str));
}
break;
case 's':
! while (len-- > 0) {
! if (s + sizeof(short) > strend)
! ashort = 0;
! else {
bcopy(s,(char*)&ashort,sizeof(short));
s += sizeof(short);
}
- str = Str_new(38,0);
- str_numset(str,(double)ashort);
- (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'n':
case 'S':
! while (len-- > 0) {
! if (s + sizeof(unsigned short) > strend)
! aushort = 0;
! else {
bcopy(s,(char*)&aushort,sizeof(unsigned short));
s += sizeof(unsigned short);
}
! str = Str_new(39,0);
#ifdef NTOHS
! if (datumtype == 'n')
! aushort = ntohs(aushort);
#endif
! str_numset(str,(double)aushort);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'i':
! while (len-- > 0) {
! if (s + sizeof(int) > strend)
! aint = 0;
! else {
bcopy(s,(char*)&aint,sizeof(int));
s += sizeof(int);
}
- str = Str_new(40,0);
- str_numset(str,(double)aint);
- (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'I':
! while (len-- > 0) {
! if (s + sizeof(unsigned int) > strend)
! auint = 0;
! else {
bcopy(s,(char*)&auint,sizeof(unsigned int));
s += sizeof(unsigned int);
}
- str = Str_new(41,0);
- str_numset(str,(double)auint);
- (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'l':
! while (len-- > 0) {
! if (s + sizeof(long) > strend)
! along = 0;
! else {
bcopy(s,(char*)&along,sizeof(long));
s += sizeof(long);
}
- str = Str_new(42,0);
- str_numset(str,(double)along);
- (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'N':
case 'L':
! while (len-- > 0) {
! if (s + sizeof(unsigned long) > strend)
! aulong = 0;
! else {
bcopy(s,(char*)&aulong,sizeof(unsigned long));
s += sizeof(unsigned long);
}
! str = Str_new(43,0);
#ifdef NTOHL
! if (datumtype == 'N')
! aulong = ntohl(aulong);
#endif
! str_numset(str,(double)aulong);
! (void)astore(stack, ++sp, str_2static(str));
}
break;
case 'p':
while (len-- > 0) {
! if (s + sizeof(char*) > strend)
! aptr = 0;
else {
bcopy(s,(char*)&aptr,sizeof(char*));
s += sizeof(char*);
--- 634,842 ----
(void)astore(stack, ++sp, str_2static(str));
break;
case 'c':
! if (len > strend - s)
! len = strend - s;
! if (checksum) {
! while (len-- > 0) {
! aint = *s++;
! if (aint >= 128) /* fake up signed chars */
! aint -= 256;
! culong += aint;
}
}
+ else {
+ while (len-- > 0) {
+ aint = *s++;
+ if (aint >= 128) /* fake up signed chars */
+ aint -= 256;
+ str = Str_new(36,0);
+ str_numset(str,(double)aint);
+ (void)astore(stack, ++sp, str_2static(str));
+ }
+ }
break;
case 'C':
! if (len > strend - s)
! len = strend - s;
! if (checksum) {
! uchar_checksum:
! while (len-- > 0) {
! auint = *s++ & 255;
! culong += auint;
}
}
+ else {
+ while (len-- > 0) {
+ auint = *s++ & 255;
+ str = Str_new(37,0);
+ str_numset(str,(double)auint);
+ (void)astore(stack, ++sp, str_2static(str));
+ }
+ }
break;
case 's':
! along = (strend - s) / sizeof(short);
! if (len > along)
! len = along;
! if (checksum) {
! while (len-- > 0) {
bcopy(s,(char*)&ashort,sizeof(short));
s += sizeof(short);
+ culong += ashort;
}
}
+ else {
+ while (len-- > 0) {
+ bcopy(s,(char*)&ashort,sizeof(short));
+ s += sizeof(short);
+ str = Str_new(38,0);
+ str_numset(str,(double)ashort);
+ (void)astore(stack, ++sp, str_2static(str));
+ }
+ }
break;
case 'n':
case 'S':
! along = (strend - s) / sizeof(unsigned short);
! if (len > along)
! len = along;
! if (checksum) {
! while (len-- > 0) {
bcopy(s,(char*)&aushort,sizeof(unsigned short));
s += sizeof(unsigned short);
+ #ifdef NTOHS
+ if (datumtype == 'n')
+ aushort = ntohs(aushort);
+ #endif
+ culong += aushort;
}
! }
! else {
! while (len-- > 0) {
! bcopy(s,(char*)&aushort,sizeof(unsigned short));
! s += sizeof(unsigned short);
! str = Str_new(39,0);
#ifdef NTOHS
! if (datumtype == 'n')
! aushort = ntohs(aushort);
#endif
! str_numset(str,(double)aushort);
! (void)astore(stack, ++sp, str_2static(str));
! }
}
break;
case 'i':
! along = (strend - s) / sizeof(int);
! if (len > along)
! len = along;
! if (checksum) {
! while (len-- > 0) {
bcopy(s,(char*)&aint,sizeof(int));
s += sizeof(int);
+ if (checksum > 32)
+ cdouble += (double)aint;
+ else
+ culong += aint;
}
}
+ else {
+ while (len-- > 0) {
+ bcopy(s,(char*)&aint,sizeof(int));
+ s += sizeof(int);
+ str = Str_new(40,0);
+ str_numset(str,(double)aint);
+ (void)astore(stack, ++sp, str_2static(str));
+ }
+ }
break;
case 'I':
! along = (strend - s) / sizeof(unsigned int);
! if (len > along)
! len = along;
! if (checksum) {
! while (len-- > 0) {
bcopy(s,(char*)&auint,sizeof(unsigned int));
s += sizeof(unsigned int);
+ if (checksum > 32)
+ cdouble += (double)auint;
+ else
+ culong += auint;
}
}
+ else {
+ while (len-- > 0) {
+ bcopy(s,(char*)&auint,sizeof(unsigned int));
+ s += sizeof(unsigned int);
+ str = Str_new(41,0);
+ str_numset(str,(double)auint);
+ (void)astore(stack, ++sp, str_2static(str));
+ }
+ }
break;
case 'l':
! along = (strend - s) / sizeof(long);
! if (len > along)
! len = along;
! if (checksum) {
! while (len-- > 0) {
bcopy(s,(char*)&along,sizeof(long));
s += sizeof(long);
+ if (checksum > 32)
+ cdouble += (double)along;
+ else
+ culong += along;
}
}
+ else {
+ while (len-- > 0) {
+ bcopy(s,(char*)&along,sizeof(long));
+ s += sizeof(long);
+ str = Str_new(42,0);
+ str_numset(str,(double)along);
+ (void)astore(stack, ++sp, str_2static(str));
+ }
+ }
break;
case 'N':
case 'L':
! along = (strend - s) / sizeof(unsigned long);
! if (len > along)
! len = along;
! if (checksum) {
! while (len-- > 0) {
bcopy(s,(char*)&aulong,sizeof(unsigned long));
s += sizeof(unsigned long);
+ #ifdef NTOHL
+ if (datumtype == 'N')
+ aulong = ntohl(aulong);
+ #endif
+ if (checksum > 32)
+ cdouble += (double)aulong;
+ else
+ culong += aulong;
}
! }
! else {
! while (len-- > 0) {
! bcopy(s,(char*)&aulong,sizeof(unsigned long));
! s += sizeof(unsigned long);
! str = Str_new(43,0);
#ifdef NTOHL
! if (datumtype == 'N')
! aulong = ntohl(aulong);
#endif
! str_numset(str,(double)aulong);
! (void)astore(stack, ++sp, str_2static(str));
! }
}
break;
case 'p':
+ along = (strend - s) / sizeof(char*);
+ if (len > along)
+ len = along;
while (len-- > 0) {
! if (sizeof(char*) > strend - s)
! break;
else {
bcopy(s,(char*)&aptr,sizeof(char*));
s += sizeof(char*);
***************
*** 674,680 ****
--- 847,969 ----
(void)astore(stack, ++sp, str_2static(str));
}
break;
+ /* float and double added gnb at melba.bby.oz.au 22/11/89 */
+ case 'f':
+ case 'F':
+ along = (strend - s) / sizeof(float);
+ if (len > along)
+ len = along;
+ if (checksum) {
+ while (len-- > 0) {
+ bcopy(s, (char *)&afloat, sizeof(float));
+ s += sizeof(float);
+ cdouble += afloat;
+ }
+ }
+ else {
+ while (len-- > 0) {
+ bcopy(s, (char *)&afloat, sizeof(float));
+ s += sizeof(float);
+ str = Str_new(47, 0);
+ str_numset(str, (double)afloat);
+ (void)astore(stack, ++sp, str_2static(str));
+ }
+ }
+ break;
+ case 'd':
+ case 'D':
+ along = (strend - s) / sizeof(double);
+ if (len > along)
+ len = along;
+ if (checksum) {
+ while (len-- > 0) {
+ bcopy(s, (char *)&adouble, sizeof(double));
+ s += sizeof(double);
+ cdouble += adouble;
+ }
+ }
+ else {
+ while (len-- > 0) {
+ bcopy(s, (char *)&adouble, sizeof(double));
+ s += sizeof(double);
+ str = Str_new(48, 0);
+ str_numset(str, (double)adouble);
+ (void)astore(stack, ++sp, str_2static(str));
+ }
+ }
+ break;
+ case 'u':
+ along = (strend - s) * 3 / 4;
+ str = Str_new(42,along);
+ while (s < strend && *s > ' ' && *s < 'a') {
+ int a,b,c,d;
+ char hunk[4];
+
+ hunk[3] = '\0';
+ len = (*s++ - ' ') & 077;
+ while (len > 0) {
+ if (s < strend && *s >= ' ')
+ a = (*s++ - ' ') & 077;
+ else
+ a = 0;
+ if (s < strend && *s >= ' ')
+ b = (*s++ - ' ') & 077;
+ else
+ b = 0;
+ if (s < strend && *s >= ' ')
+ c = (*s++ - ' ') & 077;
+ else
+ c = 0;
+ if (s < strend && *s >= ' ')
+ d = (*s++ - ' ') & 077;
+ else
+ d = 0;
+ hunk[0] = a << 2 | b >> 4;
+ hunk[1] = b << 4 | c >> 2;
+ hunk[2] = c << 6 | d;
+ str_ncat(str,hunk, len > 3 ? 3 : len);
+ len -= 3;
+ }
+ if (*s == '\n')
+ s++;
+ else if (s[1] == '\n') /* possible checksum byte */
+ s += 2;
+ }
+ (void)astore(stack, ++sp, str_2static(str));
+ break;
}
+ if (checksum) {
+ str = Str_new(42,0);
+ if (index("fFdD", datumtype) ||
+ (checksum > 32 && index("iIlLN", datumtype)) ) {
+ double modf();
+ double trouble;
+
+ adouble = 1.0;
+ while (checksum >= 16) {
+ checksum -= 16;
+ adouble *= 65536.0;
+ }
+ while (checksum >= 4) {
+ checksum -= 4;
+ adouble *= 16.0;
+ }
+ while (checksum--)
+ adouble *= 2.0;
+ along = (1 << checksum) - 1;
+ while (cdouble < 0.0)
+ cdouble += adouble;
+ cdouble = modf(cdouble / adouble, &trouble) * adouble;
+ str_numset(str,cdouble);
+ }
+ else {
+ along = (1 << checksum) - 1;
+ culong &= (unsigned long)along;
+ str_numset(str,(double)culong);
+ }
+ (void)astore(stack, ++sp, str_2static(str));
+ checksum = 0;
+ }
}
return sp;
}
***************
*** 774,782 ****
}
int
! do_splice(ary,str,gimme,arglast)
register ARRAY *ary;
- STR *str;
int gimme;
int *arglast;
{
--- 1063,1070 ----
}
int
! do_splice(ary,gimme,arglast)
register ARRAY *ary;
int gimme;
int *arglast;
{
***************
*** 1033,1039 ****
int gimme;
int *arglast;
{
! STR **st = stack->ary_array;
int sp = arglast[1];
register STR **up;
register int max = arglast[2] - sp;
--- 1321,1327 ----
int gimme;
int *arglast;
{
! register STR **st = stack->ary_array;
int sp = arglast[1];
register STR **up;
register int max = arglast[2] - sp;
***************
*** 1052,1062 ****
return sp;
}
up = &st[sp];
! for (i = 0; i < max; i++) {
! if ((*up = up[1]) && !(*up)->str_pok)
! (void)str_2ptr(*up);
! up++;
}
sp--;
if (max > 1) {
if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) {
--- 1340,1355 ----
return sp;
}
up = &st[sp];
! st += sp; /* temporarily make st point to args */
! for (i = 1; i <= max; i++) {
! if (*up = st[i]) {
! if (!(*up)->str_pok)
! (void)str_2ptr(*up);
! up++;
! }
}
+ st -= sp;
+ max = up - &st[sp];
sp--;
if (max > 1) {
if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) {
***************
*** 1090,1098 ****
qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
#endif
}
- up = &st[arglast[1]];
- while (max > 0 && !*up)
- max--,up--;
return sp+max;
}
--- 1383,1388 ----
***************
*** 1101,1110 ****
STR **str1;
STR **str2;
{
- if (!*str1)
- return -1;
- if (!*str2)
- return 1;
stab_val(firststab) = *str1;
stab_val(secondstab) = *str2;
cmd_exec(sortcmd,G_SCALAR,-1);
--- 1391,1396 ----
***************
*** 1119,1129 ****
register STR *str2 = *strp2;
int retval;
- if (!str1)
- return -1;
- if (!str2)
- return 1;
-
if (str1->str_cur < str2->str_cur) {
if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
return retval;
--- 1405,1410 ----
***************
*** 1273,1278 ****
--- 1554,1561 ----
while (entry = hiternext(hash)) {
if (dokeys) {
tmps = hiterkey(entry,&i);
+ if (!i)
+ tmps = "";
(void)astore(ary,++sp,str_2static(str_make(tmps,i)));
}
if (dovalues) {
***************
*** 1314,1319 ****
--- 1597,1604 ----
if (entry) {
if (gimme == G_ARRAY) {
tmps = hiterkey(entry, &i);
+ if (!i)
+ tmps = "";
st[++sp] = mystrk = str_make(tmps,i);
}
st[++sp] = str;
*** End of Patch 27 ***
More information about the Comp.sources.bugs
mailing list