Xref: utzoo comp.sources.bugs:2478 comp.lang.perl:2035 Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!wuarchive!zaphod.mps.ohio-state.edu!usc!elroy.jpl.nasa.gov!jpl-devvax!lwall From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) Newsgroups: comp.sources.bugs,comp.lang.perl Subject: perl 3.0 patch #27 Summary: This is an official patch for perl 3.0. Please apply it. Message-ID: <9096@jpl-devvax.JPL.NASA.GOV> Date: 10 Aug 90 21:25:31 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 1710 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 #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 + #ifdef I_VFORK + #include + #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 + * 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 + #endif #ifdef I_VFORK # include *************** *** 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@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 ***