Article View: comp.sources.bugs
Article #313perl 3.0 patch #17
From: Larry Wall
Date: Wed, 28 Mar 1990 18:21
Date: Wed, 28 Mar 1990 18:21
2109 lines
52960 bytes
52960 bytes
System: perl version 3.0
Patch #: 17
Priority: MED-HIGH
Subject: patch #16, continued
Description:
See patch #16.
Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source
directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After patching:
*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #18 FIRST ***
If patch indicates that patchlevel is the wrong version, you may need
to apply one or more previous patches, or the patch may already
have been applied. See the patchlevel.h file to find out what has or
has not been applied. In any event, don't continue with the patch.
If you are missing previous patches they can be obtained from me:
Larry Wall
lwall@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: 16
1c1
< #define PATCHLEVEL 16
---
> #define PATCHLEVEL 17
Index: config_h.SH
*** config.h.SH Tue Mar 27 16:37:27 1990
--- config_h.SH Tue Mar 27 16:37:32 1990
***************
*** 83,88 ****
--- 83,94 ----
*/
#$d_bzero BZERO /**/
+ /* CASTNEGFLOAT:
+ * This symbol, if defined, indicates that this C compiler knows how to
+ * cast negative numbers to unsigned longs, ints and shorts.
+ */
+ #$d_castneg CASTNEGFLOAT /**/
+
/* CHARSPRINTF:
* This symbol is defined if this system declares "char *sprintf()" in
* stdio.h. The trend seems to be to declare it as "int sprintf()". It
Index: consarg.c
Prereq: 3.0.1.4
*** consarg.c.old Tue Mar 27 16:37:59 1990
--- consarg.c Tue Mar 27 16:38:03 1990
***************
*** 1,4 ****
! /* $Header: consarg.c,v 3.0.1.4 90/03/12 16:24:40 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: consarg.c,v 3.0.1.5 90/03/27 15:36:45 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: consarg.c,v $
+ * Revision 3.0.1.5 90/03/27 15:36:45 lwall
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ *
* Revision 3.0.1.4 90/03/12 16:24:40 lwall
* patch13: return (@array) did counter-intuitive things
*
***************
*** 338,344 ****
str_numset(str,str_gnum(s1) / value);
break;
case O_MODULO:
! tmplong = (long)str_gnum(s2);
if (tmplong == 0L) {
yyerror("Illegal modulus of constant zero");
break;
--- 341,347 ----
str_numset(str,str_gnum(s1) / value);
break;
case O_MODULO:
! tmplong = (unsigned long)str_gnum(s2);
if (tmplong == 0L) {
yyerror("Illegal modulus of constant zero");
break;
***************
*** 407,425 ****
case O_BIT_AND:
value = str_gnum(s1);
#ifndef lint
! str_numset(str,(double)(((long)value) & ((long)str_gnum(s2))));
#endif
break;
case O_XOR:
value = str_gnum(s1);
#ifndef lint
! str_numset(str,(double)(((long)value) ^ ((long)str_gnum(s2))));
#endif
break;
case O_BIT_OR:
value = str_gnum(s1);
#ifndef lint
! str_numset(str,(double)(((long)value) | ((long)str_gnum(s2))));
#endif
break;
case O_AND:
--- 410,428 ----
case O_BIT_AND:
value = str_gnum(s1);
#ifndef lint
! str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
#endif
break;
case O_XOR:
value = str_gnum(s1);
#ifndef lint
! str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
#endif
break;
case O_BIT_OR:
value = str_gnum(s1);
#ifndef lint
! str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
#endif
break;
case O_AND:
***************
*** 455,461 ****
break;
case O_COMPLEMENT:
#ifndef lint
! str_numset(str,(double)(~(long)str_gnum(s1)));
#endif
break;
case O_SIN:
--- 458,464 ----
break;
case O_COMPLEMENT:
#ifndef lint
! str_numset(str,(double)(~U_L(str_gnum(s1))));
#endif
break;
case O_SIN:
Index: lib/ctime.pl
*** lib/ctime.pl.old Tue Mar 27 16:40:00 1990
--- lib/ctime.pl Tue Mar 27 16:40:02 1990
***************
*** 0 ****
--- 1,36 ----
+ ;# ctime.pl is a simple Perl emulation for the well known ctime(3C) function.
+ ;#
+ ;# Waldemar Kebsch, Federal Republic of Germany, November 1988
+ ;# kebsch.pad@nixpbe.UUCP
+ ;# Modified March 1990 to better handle timezones
+ ;# $Id: ctime.pl,v 1.3 90/03/22 10:49:10 hakanson Exp $
+ ;# Marion Hakanson (hakanson@cse.ogi.edu)
+ ;# Oregon Graduate Institute of Science and Technology
+ ;#
+ ;# usage:
+ ;#
+ ;# #include <ctime.pl> # see the -P and -I option in perl.man
+ ;# $Date = do ctime(time);
+
+ @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
+ @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
+ 'Jul','Aug','Sep','Oct','Nov','Dec');
+
+ sub ctime {
+ local($time) = @_;
+ local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
+
+ # Use GMT if can't find local TZ
+ $TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : 'GMT';
+ ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
+ ($TZ eq 'GMT') ? gmtime($time) : localtime($time);
+ # Hack to deal with 'PST8PDT' format of TZ
+ if ( $TZ =~ /-?\d+/ ) {
+ $TZ = $isdst ? $' : $`;
+ }
+ $TZ .= " " unless $TZ eq "";
+ $year += ($year < 70) ? 2000 : 1900;
+ sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n",
+ $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);
+ }
+ 1;
Index: msdos/dir.h
*** msdos/dir.h.old Tue Mar 27 16:40:32 1990
--- msdos/dir.h Tue Mar 27 16:40:33 1990
***************
*** 0 ****
--- 1,55 ----
+ /* $Header: dir.h,v 3.0.1.1 90/03/27 16:07:08 lwall Locked $
+ *
+ * (C) Copyright 1987, 1990 Diomidis Spinellis.
+ *
+ * You may distribute under the terms of the GNU General Public License
+ * as specified in the README file that comes with the perl 3.0 kit.
+ *
+ * $Log: dir.h,v $
+ * Revision 3.0.1.1 90/03/27 16:07:08 lwall
+ * patch16: MSDOS support
+ *
+ * Revision 1.1 90/03/18 20:32:29 dds
+ * Initial revision
+ *
+ *
+ */
+
+ /*
+ * defines the type returned by the directory(3) functions
+ */
+
+ #ifndef __DIR_INCLUDED
+ #define __DIR_INCLUDED
+
+ /*Directory entry size */
+ #ifdef DIRSIZ
+ #undef DIRSIZ
+ #endif
+ #define DIRSIZ(rp) (sizeof(struct direct))
+
+ /*
+ * Structure of a directory entry
+ */
+ struct direct {
+ ino_t d_ino; /* inode number (not used by MS-DOS) */
+ int d_namlen; /* Name length */
+ char d_name[13]; /* file name */
+ };
+
+ struct _dir_struc { /* Structure used by dir operations */
+ char *start; /* Starting position */
+ char *curr; /* Current position */
+ struct direct dirstr; /* Directory structure to return */
+ };
+
+ typedef struct _dir_struc DIR; /* Type returned by dir operations */
+
+ DIR *cdecl opendir(char *filename);
+ struct direct *readdir(DIR *dirp);
+ long telldir(DIR *dirp);
+ void seekdir(DIR *dirp,long loc);
+ void rewinddir(DIR *dirp);
+ void closedir(DIR *dirp);
+
+ #endif /* __DIR_INCLUDED */
Index: msdos/directory.c
*** msdos/directory.c.old Tue Mar 27 16:40:36 1990
--- msdos/directory.c Tue Mar 27 16:40:37 1990
***************
*** 0 ****
--- 1,178 ----
+ /* $Header: directory.c,v 3.0.1.1 90/03/27 16:07:37 lwall Locked $
+ *
+ * (C) Copyright 1987, 1988, 1990 Diomidis Spinellis.
+ *
+ * You may distribute under the terms of the GNU General Public License
+ * as specified in the README file that comes with the perl 3.0 kit.
+ *
+ * $Log: directory.c,v $
+ * Revision 3.0.1.1 90/03/27 16:07:37 lwall
+ * patch16: MSDOS support
+ *
+ * Revision 1.3 90/03/16 22:39:40 dds
+ * Fixed malloc problem.
+ *
+ * Revision 1.2 88/07/23 00:08:39 dds
+ * Added inode non-zero filling.
+ *
+ * Revision 1.1 88/07/23 00:03:50 dds
+ * Initial revision
+ *
+ */
+
+ /*
+ * UNIX compatible directory access functions
+ */
+
+ #include <sys/types.h>
+ #include <sys/dir.h>
+ #include <stddef.h>
+ #include <stdlib.h>
+ #include <string.h>
+ #include <dos.h>
+ #include <ctype.h>
+
+ /*
+ * File names are converted to lowercase if the
+ * CONVERT_TO_LOWER_CASE variable is defined.
+ */
+ #define CONVERT_TO_LOWER_CASE
+
+ #define PATHLEN 65
+
+ #ifndef lint
+ static char rcsid[] = "$Header: director.c;v 1.3 90/03/16 22:39:40 dds Exp
+ $";
+ #endif
+
+ DIR *
+ opendir(char *filename)
+ {
+ DIR *p;
+ char *oldresult, *result;
+ union REGS srv;
+ struct SREGS segregs;
+ register reslen = 0;
+ char scannamespc[PATHLEN];
+ char *scanname = scannamespc; /* To take address we need a pointer */
+
+ /*
+ * Structure used by the MS-DOS directory system calls.
+ */
+ struct dir_buff {
+ char reserved[21]; /* Reserved for MS-DOS */
+ unsigned char attribute; /* Attribute */
+ unsigned int time; /* Time */
+ unsigned int date; /* Date */
+ long size; /* Size of file */
+ char fn[13]; /* Filename */
+ } buffspc, *buff = &buffspc;
+
+
+ if (!(p = (DIR *) malloc(sizeof(DIR))))
+ return NULL;
+
+ /* Initialize result to use realloc on it */
+ if (!(result = malloc(1))) {
+ free(p);
+ return NULL;
+ }
+
+ /* Create the search pattern */
+ strcpy(scanname, filename);
+ if (strchr("/\\", *(scanname + strlen(scanname) - 1)) == NULL)
+ strcat(scanname, "/*.*");
+ else
+ strcat(scanname, "*.*");
+
+ segread(&segregs);
+ #if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
+ segregs.ds = FP_SEG(buff);
+ srv.x.dx = FP_OFF(buff);
+ #else
+ srv.x.dx = (unsigned int) buff;
+ #endif
+ srv.h.ah = 0x1a; /* Set DTA to DS:DX */
+ intdosx(&srv, &srv, &segregs);
+
+ #if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
+ segregs.ds = FP_SEG(scanname);
+ srv.x.dx = FP_OFF(scanname);
+ #else
+ srv.x.dx = (unsigned int) scanname;
+ #endif
+ srv.x.cx = 0xff; /* Search mode */
+
+ for (srv.h.ah = 0x4e; !intdosx(&srv, &srv, &segregs); srv.h.ah = 0x4f) {
+ if ((result = (char *) realloc(result, reslen + strlen(buff->fn) + 1)) ==
+ NULL) {
+ free(p);
+ free(oldresult);
+ return NULL;
+ }
+ oldresult = result;
+ #ifdef CONVERT_TO_LOWER_CASE
+ strcpy(result + reslen, strlwr(buff->fn));
+ #else
+ strcpy(result + reslen, buff->fn);
+ #endif
+ reslen += strlen(buff->fn) + 1;
+ }
+
+ if (!(result = realloc(result, reslen + 1))) {
+ free(p);
+ free(oldresult);
+ return NULL;
+ } else {
+ p->start = result;
+ p->curr = result;
+ *(result + reslen) = '\0';
+ return p;
+ }
+ }
+
+
+ struct direct *
+ readdir(DIR *dirp)
+ {
+ char *p;
+ register len;
+ static dummy;
+
+ p = dirp->curr;
+ len = strlen(p);
+ if (*p) {
+ dirp->curr += len + 1;
+ strcpy(dirp->dirstr.d_name, p);
+ dirp->dirstr.d_namlen = len;
+ /* To fool programs */
+ dirp->dirstr.d_ino = ++dummy;
+ return &(dirp->dirstr);
+ } else
+ return NULL;
+ }
+
+ long
+ telldir(DIR *dirp)
+ {
+ return (long) dirp->curr; /* ouch! pointer to long cast */
+ }
+
+ void
+ seekdir(DIR *dirp, long loc)
+ {
+ dirp->curr = (char *) loc; /* ouch! long to pointer cast */
+ }
+
+ void
+ rewinddir(DIR *dirp)
+ {
+ dirp->curr = dirp->start;
+ }
+
+ void
+ closedir(DIR *dirp)
+ {
+ free(dirp->start);
+ free(dirp);
+ }
Index: doarg.c
Prereq: 3.0.1.4
*** doarg.c.old Tue Mar 27 16:38:13 1990
--- doarg.c Tue Mar 27 16:38:17 1990
***************
*** 1,4 ****
! /* $Header: doarg.c,v 3.0.1.4 90/03/12 16:28:42 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: doarg.c,v 3.0.1.5 90/03/27 15:39:03 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: doarg.c,v $
+ * Revision 3.0.1.5 90/03/27 15:39:03 lwall
+ * patch16: MSDOS support
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * patch16: sprintf($s,...,$s,...) didn't work
+ *
* Revision 3.0.1.4 90/03/12 16:28:42 lwall
* patch13: pack of ascii strings could call str_ncat() with negative length
* patch13: printf("%s", *foo) was busted
***************
*** 41,46 ****
--- 46,55 ----
int wantarray;
+ #ifdef BUGGY_MSC
+ #pragma function(memcmp)
+ #endif /* BUGGY_MSC */
+
int
do_subst(str,arg,sp)
STR *str;
***************
*** 289,294 ****
--- 298,306 ----
stack->ary_array[++sp] = arg->arg_ptr.arg_str;
return sp;
}
+ #ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+ #endif /* BUGGY_MSC */
int
do_trans(str,arg)
***************
*** 448,454 ****
case 'I':
while (len-- > 0) {
fromstr = NEXTFROM;
! auint = (unsigned int)str_gnum(fromstr);
str_ncat(str,(char*)&auint,sizeof(unsigned int));
}
break;
--- 460,466 ----
case 'I':
while (len-- > 0) {
fromstr = NEXTFROM;
! auint = U_I(str_gnum(fromstr));
str_ncat(str,(char*)&auint,sizeof(unsigned int));
}
break;
***************
*** 472,478 ****
case 'L':
while (len-- > 0) {
fromstr = NEXTFROM;
! aulong = (unsigned long)str_gnum(fromstr);
str_ncat(str,(char*)&aulong,sizeof(unsigned long));
}
break;
--- 484,490 ----
case 'L':
while (len-- > 0) {
fromstr = NEXTFROM;
! aulong = U_L(str_gnum(fromstr));
str_ncat(str,(char*)&aulong,sizeof(unsigned long));
}
break;
***************
*** 511,520 ****
char *xs;
int xlen;
double value;
str_set(str,"");
len--; /* don't count pattern string */
! s = str_get(*sarg);
send = s + (*sarg)->str_cur;
sarg++;
for ( ; s < send; len--) {
--- 523,533 ----
char *xs;
int xlen;
double value;
+ char *origs;
str_set(str,"");
len--; /* don't count pattern string */
! origs = s = str_get(*sarg);
send = s + (*sarg)->str_cur;
sarg++;
for ( ; s < send; len--) {
***************
*** 578,596 ****
ch = *(++t);
*t = '\0';
value = str_gnum(*(sarg++));
- #if defined(sun) && !defined(sparc)
- if (value < 0.0) { /* sigh */
- if (dolong)
- (void)sprintf(buf,s,(long)value);
- else
- (void)sprintf(buf,s,(int)value);
- }
- else
- #endif
if (dolong)
! (void)sprintf(buf,s,(unsigned long)value);
else
! (void)sprintf(buf,s,(unsigned int)value);
s = t;
*(t--) = ch;
break;
--- 591,600 ----
ch = *(++t);
*t = '\0';
value = str_gnum(*(sarg++));
if (dolong)
! (void)sprintf(buf,s,U_L(value));
else
! (void)sprintf(buf,s,U_I(value));
s = t;
*(t--) = ch;
break;
***************
*** 616,625 ****
if (strEQ(t-2,"%s")) { /* some printfs fail on >128 chars */
*buf = '\0';
str_ncat(str,s,t - s - 2);
str_ncat(str,xs,xlen); /* so handle simple case */
}
! else
(void)sprintf(buf,s,xs);
sarg++;
s = t;
*(t--) = ch;
--- 620,636 ----
if (strEQ(t-2,"%s")) { /* some printfs fail on >128 chars */
*buf = '\0';
str_ncat(str,s,t - s - 2);
+ *t = ch;
str_ncat(str,xs,xlen); /* so handle simple case */
}
! else {
! if (origs == xs) { /* sprintf($s,...$s...) */
! strcpy(tokenbuf+64,s);
! s = tokenbuf+64;
! *t = ch;
! }
(void)sprintf(buf,s,xs);
+ }
sarg++;
s = t;
*(t--) = ch;
***************
*** 1165,1171 ****
register int offset;
register int size;
register unsigned char *s = (unsigned char*)mstr->str_ptr;
! register unsigned long lval = (unsigned long)str_gnum(str);
int mask;
mstr->str_rare = 0;
--- 1176,1182 ----
register int offset;
register int size;
register unsigned char *s = (unsigned char*)mstr->str_ptr;
! register unsigned long lval = U_L(str_gnum(str));
int mask;
mstr->str_rare = 0;
Index: doio.c
Prereq: 3.0.1.7
*** doio.c.old Tue Mar 27 16:38:35 1990
--- doio.c Tue Mar 27 16:38:40 1990
***************
*** 1,4 ****
! /* $Header: doio.c,v 3.0.1.7 90/03/14 12:26:24 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: doio.c,v 3.0.1.8 90/03/27 15:44:02 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: doio.c,v $
+ * Revision 3.0.1.8 90/03/27 15:44:02 lwall
+ * patch16: MSDOS support
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * patch16: system() can lose arguments passed to shell scripts on SysV machines
+ *
* Revision 3.0.1.7 90/03/14 12:26:24 lwall
* patch15: commands involving execs could cause malloc arena corruption
*
***************
*** 283,290 ****
--- 288,297 ----
#ifdef FCHOWN
(void)fchown(fileno(stab_io(argvoutstab)->ifp),fileuid,filegid);
#else
+ #ifdef CHOWN
(void)chown(oldname,fileuid,filegid);
#endif
+ #endif
}
str_free(str);
return stab_io(stab)->ifp;
***************
*** 300,305 ****
--- 307,313 ----
return Nullfp;
}
+ #ifdef PIPE
void
do_pipe(str, rstab, wstab)
STR *str;
***************
*** 342,347 ****
--- 350,356 ----
str_sset(str,&str_undef);
return;
}
+ #endif
bool
do_close(stab,explicit)
***************
*** 361,367 ****
if (stio->type == '|') {
status = mypclose(stio->ifp);
retval = (status >= 0);
! statusvalue = (unsigned)status & 0xffff;
}
else if (stio->type == '-')
retval = TRUE;
--- 370,376 ----
if (stio->type == '|') {
status = mypclose(stio->ifp);
retval = (status >= 0);
! statusvalue = (unsigned short)status & 0xffff;
}
else if (stio->type == '-')
retval = TRUE;
***************
*** 897,902 ****
--- 906,912 ----
register char *s;
char **argv;
char flags[10];
+ char *cmd2;
#ifdef TAINT
taintenv();
***************
*** 949,957 ****
}
}
New(402,argv, (s - cmd) / 2 + 2, char*);
!
a = argv;
! for (s = cmd; *s;) {
while (*s && isspace(*s)) s++;
if (*s)
*(a++) = s;
--- 959,967 ----
}
}
New(402,argv, (s - cmd) / 2 + 2, char*);
! cmd2 = nsavestr(cmd, s-cmd);
a = argv;
! for (s = cmd2; *s;) {
while (*s && isspace(*s)) s++;
if (*s)
*(a++) = s;
***************
*** 962,970 ****
*a = Nullch;
if (argv[0]) {
execvp(argv[0],argv);
! if (errno == ENOEXEC) /* for system V NIH syndrome */
goto doshell;
}
Safefree(argv);
return FALSE;
}
--- 972,984 ----
*a = Nullch;
if (argv[0]) {
execvp(argv[0],argv);
! if (errno == ENOEXEC) { /* for system V NIH syndrome */
! Safefree(argv);
! Safefree(cmd2);
goto doshell;
+ }
}
+ Safefree(cmd2);
Safefree(argv);
return FALSE;
}
***************
*** 1944,1949 ****
--- 1958,1964 ----
}
}
break;
+ #ifdef CHOWN
case O_CHOWN:
#ifdef TAINT
taintproper("Insecure dependency in chown");
***************
*** 1959,1964 ****
--- 1974,1981 ----
}
}
break;
+ #endif
+ #ifdef KILL
case O_KILL:
#ifdef TAINT
taintproper("Insecure dependency in kill");
***************
*** 1994,1999 ****
--- 2011,2017 ----
}
}
break;
+ #endif
case O_UNLINK:
#ifdef TAINT
taintproper("Insecure dependency in unlink");
Index: dolist.c
Prereq: 3.0.1.6
*** dolist.c.old Tue Mar 27 16:38:57 1990
--- dolist.c Tue Mar 27 16:39:02 1990
***************
*** 1,4 ****
! /* $Header: dolist.c,v 3.0.1.6 90/03/12 16:33:02 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: dolist.c,v 3.0.1.7 90/03/27 15:48:42 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,18 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.7 90/03/27 15:48:42 lwall
+ * patch16: MSDOS support
+ * patch16: use of $`, $& or $' sometimes causes memory leakage
+ * patch16: splice(@array,0,$n) case cause duplicate free
+ * patch16: grep blows up on undefined array values
+ * patch16: .. now works using magical string increment
+ *
* Revision 3.0.1.6 90/03/12 16:33:02 lwall
* patch13: added list slice operator (LIST)[LIST]
* patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
***************
*** 43,48 ****
--- 50,59 ----
#include "perl.h"
+ #ifdef BUGGY_MSC
+ #pragma function(memcmp)
+ #endif /* BUGGY_MSC */
+
int
do_match(str,arg,gimme,arglast)
STR *str;
***************
*** 242,247 ****
--- 253,260 ----
if (sawampersand) {
char *tmps;
+ if (spat->spat_regexp->subbase)
+ Safefree(spat->spat_regexp->subbase);
tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
***************
*** 262,267 ****
--- 275,284 ----
return sp;
}
+ #ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+ #endif /* BUGGY_MSC */
+
int
do_split(str,spat,limit,gimme,arglast)
STR *str;
***************
*** 846,851 ****
--- 863,869 ----
for (i = offset; i > 0; i--) /* can't trust Copy */
*dst-- = *src--;
}
+ Zero(ary->ary_array, -diff, STR*);
ary->ary_array -= diff; /* diff is negative */
ary->ary_max += diff;
}
***************
*** 956,962 ****
}
arg = arg[1].arg_ptr.arg_arg;
while (i-- > 0) {
! stab_val(defstab) = st[src];
(void)eval(arg,G_SCALAR,sp);
st = stack->ary_array;
if (str_true(st[sp+1]))
--- 974,983 ----
}
arg = arg[1].arg_ptr.arg_arg;
while (i-- > 0) {
! if (st[src])
! stab_val(defstab) = st[src];
! else
! stab_val(defstab) = str_static(&str_undef);
(void)eval(arg,G_SCALAR,sp);
st = stack->ary_array;
if (str_true(st[sp+1]))
***************
*** 1124,1140 ****
{
STR **st = stack->ary_array;
register int sp = arglast[0];
! register int i = (int)str_gnum(st[sp+1]);
register ARRAY *ary = stack;
register STR *str;
! int max = (int)str_gnum(st[sp+2]);
if (gimme != G_ARRAY)
fatal("panic: do_range");
! while (i <= max) {
! (void)astore(ary, ++sp, str = str_static(&str_no));
! str_numset(str,(double)i++);
}
return sp;
}
--- 1145,1180 ----
{
STR **st = stack->ary_array;
register int sp = arglast[0];
! register int i;
register ARRAY *ary = stack;
register STR *str;
! int max;
if (gimme != G_ARRAY)
fatal("panic: do_range");
! if (st[sp+1]->str_nok ||
! (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
! i = (int)str_gnum(st[sp+1]);
! max = (int)str_gnum(st[sp+2]);
! while (i <= max) {
! (void)astore(ary, ++sp, str = str_static(&str_no));
! str_numset(str,(double)i++);
! }
! }
! else {
! STR *final = str_static(st[sp+2]);
! char *tmps = str_get(final);
!
! str = str_static(st[sp+1]);
! while (!str->str_nok && str->str_cur <= final->str_cur &&
! strNE(str->str_ptr,tmps) ) {
! (void)astore(ary, ++sp, str);
! str = str_static(str);
! str_inc(str);
! }
! if (strEQ(str->str_ptr,tmps))
! (void)astore(ary, ++sp, str);
}
return sp;
}
Index: dump.c
Prereq: 3.0
*** dump.c.old Tue Mar 27 16:39:13 1990
--- dump.c Tue Mar 27 16:39:14 1990
***************
*** 1,4 ****
! /* $Header: dump.c,v 3.0 89/10/18 15:11:16 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: dump.c,v 3.0.1.1 90/03/27 15:49:58 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dump.c,v $
+ * Revision 3.0.1.1 90/03/27 15:49:58 lwall
+ * patch16: changed unsigned to unsigned int
+ *
* Revision 3.0 89/10/18 15:11:16 lwall
* 3.0 baseline
*
***************
*** 217,223 ****
dump_flags(b,flags)
char *b;
! unsigned flags;
{
*b = '\0';
if (flags & AF_ARYOK)
--- 220,226 ----
dump_flags(b,flags)
char *b;
! unsigned int flags;
{
*b = '\0';
if (flags & AF_ARYOK)
Index: eval.c
Prereq: 3.0.1.5
*** eval.c.old Tue Mar 27 16:39:28 1990
--- eval.c Tue Mar 27 16:39:34 1990
***************
*** 1,4 ****
! /* $Header: eval.c,v 3.0.1.5 90/03/12 16:37:40 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: eval.c,v 3.0.1.6 90/03/27 15:53:51 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: eval.c,v $
+ * Revision 3.0.1.6 90/03/27 15:53:51 lwall
+ * patch16: MSDOS support
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * patch16: ioctl didn't return values correctly
+ *
* Revision 3.0.1.5 90/03/12 16:37:40 lwall
* patch13: undef $/ didn't work as advertised
* patch13: added list slice operator (LIST)[LIST]
***************
*** 47,52 ****
--- 52,60 ----
#include <signal.h>
+ #ifdef I_FCNTL
+ #include <fcntl.h>
+ #endif
#ifdef I_VFORK
# include <vfork.h>
#endif
***************
*** 289,295 ****
value = str_gnum(st[1]);
anum = (int)str_gnum(st[2]);
#ifndef lint
! value = (double)(((unsigned long)value) << anum);
#endif
goto donumset;
case O_RIGHT_SHIFT:
--- 297,303 ----
value = str_gnum(st[1]);
anum = (int)str_gnum(st[2]);
#ifndef lint
! value = (double)(U_L(value) << anum);
#endif
goto donumset;
case O_RIGHT_SHIFT:
***************
*** 296,302 ****
value = str_gnum(st[1]);
anum = (int)str_gnum(st[2]);
#ifndef lint
! value = (double)(((unsigned long)value) >> anum);
#endif
goto donumset;
case O_LT:
--- 304,310 ----
value = str_gnum(st[1]);
anum = (int)str_gnum(st[2]);
#ifndef lint
! value = (double)(U_L(value) >> anum);
#endif
goto donumset;
case O_LT:
***************
*** 332,339 ****
if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
value = str_gnum(st[1]);
#ifndef lint
! value = (double)(((unsigned long)value) &
! (unsigned long)str_gnum(st[2]));
#endif
goto donumset;
}
--- 340,346 ----
if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
value = str_gnum(st[1]);
#ifndef lint
! value = (double)(U_L(value) & U_L(str_gnum(st[2])));
#endif
goto donumset;
}
***************
*** 344,351 ****
if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
value = str_gnum(st[1]);
#ifndef lint
! value = (double)(((unsigned long)value) ^
! (unsigned long)str_gnum(st[2]));
#endif
goto donumset;
}
--- 351,357 ----
if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
value = str_gnum(st[1]);
#ifndef lint
! value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
#endif
goto donumset;
}
***************
*** 356,363 ****
if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
value = str_gnum(st[1]);
#ifndef lint
! value = (double)(((unsigned long)value) |
! (unsigned long)str_gnum(st[2]));
#endif
goto donumset;
}
--- 362,368 ----
if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
value = str_gnum(st[1]);
#ifndef lint
! value = (double)(U_L(value) | U_L(str_gnum(st[2])));
#endif
goto donumset;
}
***************
*** 436,442 ****
goto donumset;
case O_COMPLEMENT:
#ifndef lint
! value = (double) ~(unsigned long)str_gnum(st[1]);
#endif
goto donumset;
case O_SELECT:
--- 441,447 ----
goto donumset;
case O_COMPLEMENT:
#ifndef lint
! value = (double) ~U_L(str_gnum(st[1]));
#endif
goto donumset;
case O_SELECT:
***************
*** 1330,1356 ****
}
break;
case O_FORK:
anum = fork();
if (!anum && (tmpstab = stabent("$",allstabs)))
str_numset(STAB_STR(tmpstab),(double)getpid());
value = (double)anum;
goto donumset;
case O_WAIT:
#ifndef lint
- /* ihand = signal(SIGINT, SIG_IGN); */
- /* qhand = signal(SIGQUIT, SIG_IGN); */
anum = wait(&argflags);
if (anum > 0)
pidgone(anum,argflags);
value = (double)anum;
- #else
- /* ihand = qhand = 0; */
#endif
- /* (void)signal(SIGINT, ihand); */
- /* (void)signal(SIGQUIT, qhand); */
statusvalue = (unsigned short)argflags;
goto donumset;
case O_SYSTEM:
#ifdef TAINT
if (arglast[2] - arglast[1] == 1) {
taintenv();
--- 1335,1366 ----
}
break;
case O_FORK:
+ #ifdef FORK
anum = fork();
if (!anum && (tmpstab = stabent("$",allstabs)))
str_numset(STAB_STR(tmpstab),(double)getpid());
value = (double)anum;
goto donumset;
+ #else
+ fatal("Unsupported function fork");
+ break;
+ #endif
case O_WAIT:
+ #ifdef WAIT
#ifndef lint
anum = wait(&argflags);
if (anum > 0)
pidgone(anum,argflags);
value = (double)anum;
#endif
statusvalue = (unsigned short)argflags;
goto donumset;
+ #else
+ fatal("Unsupported function wait");
+ break;
+ #endif
case O_SYSTEM:
+ #ifdef FORK
#ifdef TAINT
if (arglast[2] - arglast[1] == 1) {
taintenv();
***************
*** 1392,1397 ****
--- 1402,1417 ----
value = (double)do_exec(str_get(str_static(st[2])));
}
_exit(-1);
+ #else /* ! FORK */
+ if ((arg[1].arg_type & A_MASK) == A_STAB)
+ value = (double)do_aspawn(st[1],arglast);
+ else if (arglast[2] - arglast[1] != 1)
+ value = (double)do_aspawn(Nullstr,arglast);
+ else {
+ value = (double)do_spawn(str_get(str_static(st[2])));
+ }
+ goto donumset;
+ #endif /* FORK */
case O_EXEC:
if ((arg[1].arg_type & A_MASK) == A_STAB)
value = (double)do_aexec(st[1],arglast);
***************
*** 1443,1456 ****
out:
value = (double)anum;
goto donumset;
- case O_CHMOD:
case O_CHOWN:
case O_KILL:
case O_UNLINK:
case O_UTIME:
value = (double)apply(optype,arglast);
goto donumset;
case O_UMASK:
if (maxarg < 1) {
anum = umask(0);
(void)umask(anum);
--- 1463,1491 ----
out:
value = (double)anum;
goto donumset;
case O_CHOWN:
+ #ifdef CHOWN
+ value = (double)apply(optype,arglast);
+ goto donumset;
+ #else
+ fatal("Unsupported function chown");
+ break;
+ #endif
case O_KILL:
+ #ifdef KILL
+ value = (double)apply(optype,arglast);
+ goto donumset;
+ #else
+ fatal("Unsupported function kill");
+ break;
+ #endif
case O_UNLINK:
+ case O_CHMOD:
case O_UTIME:
value = (double)apply(optype,arglast);
goto donumset;
case O_UMASK:
+ #ifdef UMASK
if (maxarg < 1) {
anum = umask(0);
(void)umask(anum);
***************
*** 1462,1467 ****
--- 1497,1506 ----
taintproper("Insecure dependency in umask");
#endif
goto donumset;
+ #else
+ fatal("Unsupported function umask");
+ break;
+ #endif
case O_RENAME:
tmps = str_get(st[1]);
tmps2 = str_get(st[2]);
***************
*** 1480,1485 ****
--- 1519,1525 ----
#endif
goto donumset;
case O_LINK:
+ #ifdef LINK
tmps = str_get(st[1]);
tmps2 = str_get(st[2]);
#ifdef TAINT
***************
*** 1487,1492 ****
--- 1527,1536 ----
#endif
value = (double)(link(tmps,tmps2) >= 0);
goto donumset;
+ #else
+ fatal("Unsupported function link");
+ break;
+ #endif
case O_MKDIR:
tmps = str_get(st[1]);
anum = (int)str_gnum(st[2]);
***************
*** 1566,1573 ****
--- 1610,1622 ----
goto one_liner; /* see above in MKDIR */
#endif
case O_GETPPID:
+ #ifdef GETPPID
value = (double)getppid();
goto donumset;
+ #else
+ fatal("Unsupported function getppid");
+ break;
+ #endif
case O_GETPGRP:
#ifdef GETPGRP
if (maxarg < 1)
***************
*** 1618,1623 ****
--- 1667,1673 ----
break;
#endif
case O_CHROOT:
+ #ifdef CHROOT
if (maxarg < 1)
tmps = str_get(stab_val(defstab));
else
***************
*** 1627,1632 ****
--- 1677,1686 ----
#endif
value = (double)(chroot(tmps) >= 0);
goto donumset;
+ #else
+ fatal("Unsupported function chroot");
+ break;
+ #endif
case O_FCNTL:
case O_IOCTL:
if (maxarg <= 0)
***************
*** 1635,1641 ****
stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
! argtype = (unsigned int)str_gnum(st[2]);
#ifdef TAINT
taintproper("Insecure dependency in ioctl");
#endif
--- 1689,1695 ----
stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
! argtype = U_I(str_gnum(st[2]));
#ifdef TAINT
taintproper("Insecure dependency in ioctl");
#endif
***************
*** 1642,1649 ****
anum = do_ctl(optype,stab,argtype,st[3]);
if (anum == -1)
goto say_undef;
! if (anum != 0)
goto donumset;
str_set(str,"0 but true");
STABSET(str);
break;
--- 1696,1705 ----
anum = do_ctl(optype,stab,argtype,st[3]);
if (anum == -1)
goto say_undef;
! if (anum != 0) {
! value = (double)anum;
goto donumset;
+ }
str_set(str,"0 but true");
STABSET(str);
break;
***************
*** 1762,1769 ****
--- 1818,1829 ----
anum = S_IFCHR;
goto check_file_type;
case O_FTBLK:
+ #ifdef S_IFBLK
anum = S_IFBLK;
goto check_file_type;
+ #else
+ goto say_no;
+ #endif
case O_FTFILE:
anum = S_IFREG;
goto check_file_type;
***************
*** 1802,1808 ****
value = (double)(symlink(tmps,tmps2) >= 0);
goto donumset;
#else
! fatal("Unsupported function symlink()");
#endif
case O_READLINK:
#ifdef SYMLINK
--- 1862,1868 ----
value = (double)(symlink(tmps,tmps2) >= 0);
goto donumset;
#else
! fatal("Unsupported function symlink");
#endif
case O_READLINK:
#ifdef SYMLINK
***************
*** 1816,1831 ****
str_nset(str,buf,anum);
break;
#else
! fatal("Unsupported function readlink()");
#endif
case O_FTSUID:
anum = S_ISUID;
goto check_xid;
case O_FTSGID:
anum = S_ISGID;
goto check_xid;
case O_FTSVTX:
anum = S_ISVTX;
check_xid:
if (mystat(arg,st[1]) < 0)
goto say_undef;
--- 1876,1903 ----
str_nset(str,buf,anum);
break;
#else
! fatal("Unsupported function readlink");
#endif
case O_FTSUID:
+ #ifdef S_ISUID
anum = S_ISUID;
goto check_xid;
+ #else
+ goto say_no;
+ #endif
case O_FTSGID:
+ #ifdef S_ISGID
anum = S_ISGID;
goto check_xid;
+ #else
+ goto say_no;
+ #endif
case O_FTSVTX:
+ #ifdef S_ISVTX
anum = S_ISVTX;
+ #else
+ goto say_no;
+ #endif
check_xid:
if (mystat(arg,st[1]) < 0)
goto say_undef;
***************
*** 2058,2063 ****
--- 2130,2151 ----
goto say_undef;
value = fileno(fp);
goto donumset;
+ case O_BINMODE:
+ if (maxarg < 1)
+ goto say_undef;
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ stab = arg[1].arg_ptr.arg_stab;
+ else
+ stab = stabent(str_get(st[1]),TRUE);
+ if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
+ goto say_undef;
+ #ifdef MSDOS
+ str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
+ #else
+ str_set(str, Yes);
+ #endif
+ STABSET(str);
+ break;
case O_VEC:
sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
goto array_return;
***************
*** 2064,2069 ****
--- 2152,2158 ----
case O_GPWNAM:
case O_GPWUID:
case O_GPWENT:
+ #ifdef PASSWD
sp = do_gpwent(optype,
gimme,arglast);
goto array_return;
***************
*** 2073,2081 ****
--- 2162,2177 ----
case O_EPWENT:
value = (double) endpwent();
goto donumset;
+ #else
+ case O_EPWENT:
+ case O_SPWENT:
+ fatal("Unsupported password function");
+ break;
+ #endif
case O_GGRNAM:
case O_GGRGID:
case O_GGRENT:
+ #ifdef GROUP
sp = do_ggrent(optype,
gimme,arglast);
goto array_return;
***************
*** 2085,2094 ****
--- 2181,2200 ----
case O_EGRENT:
value = (double) endgrent();
goto donumset;
+ #else
+ case O_EGRENT:
+ case O_SGRENT:
+ fatal("Unsupported group function");
+ break;
+ #endif
case O_GETLOGIN:
+ #ifdef GETLOGIN
if (!(tmps = getlogin()))
goto say_undef;
str_set(str,tmps);
+ #else
+ fatal("Unsupported function getlogin");
+ #endif
break;
case O_OPENDIR:
case O_READDIR:
***************
*** 2108,2113 ****
--- 2214,2220 ----
value = (double)do_syscall(arglast);
goto donumset;
case O_PIPE:
+ #ifdef PIPE
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
***************
*** 2118,2123 ****
--- 2225,2233 ----
stab2 = stabent(str_get(st[2]),TRUE);
do_pipe(str,stab,stab2);
STABSET(str);
+ #else
+ fatal("Unsupported function pipe");
+ #endif
break;
}
Index: evalargs.xc
Prereq: 3.0.1.4
*** evalargs.xc.old Tue Mar 27 16:39:47 1990
--- evalargs.xc Tue Mar 27 16:39:49 1990
***************
*** 2,10 ****
* kit sizes from getting too big.
*/
! /* $Header: evalargs.xc,v 3.0.1.4 90/02/28 17:38:37 lwall Locked $
*
* $Log: evalargs.xc,v $
* Revision 3.0.1.4 90/02/28 17:38:37 lwall
* patch9: $#foo -= 2 didn't work
*
--- 2,13 ----
* kit sizes from getting too big.
*/
! /* $Header: evalargs.xc,v 3.0.1.5 90/03/27 15:54:42 lwall Locked $
*
* $Log: evalargs.xc,v $
+ * Revision 3.0.1.5 90/03/27 15:54:42 lwall
+ * patch16: MSDOS support
+ *
* Revision 3.0.1.4 90/02/28 17:38:37 lwall
* patch9: $#foo -= 2 didn't work
*
***************
*** 249,259 ****
argflags |= AF_POST; /* enable newline chopping */
last_in_stab = argptr.arg_stab;
old_record_separator = record_separator;
#ifdef CSH
record_separator = 0;
#else
record_separator = '\n';
! #endif
goto do_read;
case A_READ:
last_in_stab = argptr.arg_stab;
--- 252,266 ----
argflags |= AF_POST; /* enable newline chopping */
last_in_stab = argptr.arg_stab;
old_record_separator = record_separator;
+ #ifdef MSDOS
+ record_separator = 0;
+ #else
#ifdef CSH
record_separator = 0;
#else
record_separator = '\n';
! #endif /* !CSH */
! #endif /* !MSDOS */
goto do_read;
case A_READ:
last_in_stab = argptr.arg_stab;
***************
*** 285,290 ****
--- 292,302 ----
(void) interp(str,stab_val(last_in_stab),sp);
st = stack->ary_array;
tmpstr = Str_new(55,0);
+ #ifdef MSDOS
+ str_set(tmpstr, "glob ");
+ str_scat(tmpstr,str);
+ str_cat(tmpstr," |");
+ #else
#ifdef CSH
str_nset(tmpstr,cshname,cshlen);
str_cat(tmpstr," -cf 'set nonomatch; glob ");
***************
*** 295,301 ****
str_scat(tmpstr,str);
str_cat(tmpstr,
"|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
! #endif
(void)do_open(last_in_stab,tmpstr->str_ptr,
tmpstr->str_cur);
fp = stab_io(last_in_stab)->ifp;
--- 307,314 ----
str_scat(tmpstr,str);
str_cat(tmpstr,
"|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
! #endif /* !CSH */
! #endif /* !MSDOS */
(void)do_open(last_in_stab,tmpstr->str_ptr,
tmpstr->str_cur);
fp = stab_io(last_in_stab)->ifp;
Index: msdos/glob.c
*** msdos/glob.c.old Tue Mar 27 16:40:47 1990
--- msdos/glob.c Tue Mar 27 16:40:48 1990
***************
*** 0 ****
--- 1,17 ----
+ /*
+ * Globbing for MS-DOS. Relies on the expansion done by the library
+ * startup code. (dds)
+ */
+
+ #include <stdio.h>
+ #include <string.h>
+
+ main(int argc, char *argv[])
+ {
+ register i;
+
+ for (i = 1; i < argc; i++) {
+ fputs(strlwr(argv[i]), stdout);
+ putchar(0);
+ }
+ }
Index: hash.c
Prereq: 3.0.1.2
*** hash.c.old Tue Mar 27 16:39:55 1990
--- hash.c Tue Mar 27 16:39:57 1990
***************
*** 1,4 ****
! /* $Header: hash.c,v 3.0.1.2 89/12/21 20:03:39 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: hash.c,v 3.0.1.3 90/03/27 15:59:09 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: hash.c,v $
+ * Revision 3.0.1.3 90/03/27 15:59:09 lwall
+ * patch16: @dbmvalues{'foo','bar'} could use the same cache entry for both values
+ *
* Revision 3.0.1.2 89/12/21 20:03:39 lwall
* patch7: errno may now be a macro with an lvalue
*
***************
*** 161,172 ****
}
#ifdef SOME_DBM
else if (tb->tbl_dbm) { /* is this just a cache for dbm file? */
entry = tb->tbl_array[hash & tb->tbl_max];
oentry = &entry->hent_next;
entry = *oentry;
while (entry) { /* trim chain down to 1 entry */
*oentry = entry->hent_next;
! hentfree(entry); /* no doubt they'll want this next. */
entry = *oentry;
}
}
--- 164,177 ----
}
#ifdef SOME_DBM
else if (tb->tbl_dbm) { /* is this just a cache for dbm file? */
+ void hentdelayfree();
+
entry = tb->tbl_array[hash & tb->tbl_max];
oentry = &entry->hent_next;
entry = *oentry;
while (entry) { /* trim chain down to 1 entry */
*oentry = entry->hent_next;
! hentdelayfree(entry); /* no doubt they'll want this next. */
entry = *oentry;
}
}
***************
*** 312,317 ****
--- 317,333 ----
if (!hent)
return;
str_free(hent->hent_val);
+ Safefree(hent->hent_key);
+ Safefree(hent);
+ }
+
+ void
+ hentdelayfree(hent)
+ register HENT *hent;
+ {
+ if (!hent)
+ return;
+ str_2static(hent->hent_val); /* free between statements */
Safefree(hent->hent_key);
Safefree(hent);
}
Index: msdos/eg/crlf.bat
*** msdos/eg/crlf.bat.old Tue Mar 27 17:26:13 1990
--- msdos/eg/crlf.bat Tue Mar 27 17:26:14 1990
***************
*** 0 ****
--- 1,32 ----
+ @REM=("
+ @perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+ @end ") if 0 ;
+
+ # Convert all the files in the current directory from unix to MS-DOS
+ # line ending conventions.
+ #
+ # By Diomidis Spinellis
+ #
+ open(FILES, 'find . -print |');
+ while ($file = <FILES>) {
+ $file =^ s/[\n\r]//;
+ if (-f $file) {
+ if (-B $file) {
+ print STDERR "Skipping binary file $file\n";
+ next;
+ }
+ ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime,
+ $blksize, $blocks) = stat($file);
+ open(IFILE, "$file");
+ open(OFILE, ">xl$$");
+ while (<IFILE>) {
+ print OFILE;
+ }
+ close(OFILE) || die "close xl$$: $!\n";
+ close(IFILE) || die "close $file: $!\n";
+ unlink($file) || die "unlink $file: $!\n";
+ rename("xl$$", $file) || die "rename(xl$$, $file): $!\n";
+ chmod($mode, $file) || die "chmod($mode, $file: $!\n";
+ utime($atime, $mtime, $file) || die "utime($atime, $mtime, $file): $!\n";
+ }
+ }
Index: msdos/eg/lf.bat
*** msdos/eg/lf.bat.old Tue Mar 27 16:40:42 1990
--- msdos/eg/lf.bat Tue Mar 27 16:40:45 1990
***************
*** 0 ****
--- 1,33 ----
+ @REM=("
+ @perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+ @end ") if 0 ;
+
+ # Convert all the files in the current directory from MS-DOS to unix
+ # line ending conventions.
+ #
+ # By Diomidis Spinellis
+ #
+ open(FILES, 'find . -print |');
+ while ($file = <FILES>) {
+ $file =^ s/[\n\r]//;
+ if (-f $file) {
+ if (-B $file) {
+ print STDERR "Skipping binary file $file\n";
+ next;
+ }
+ ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime,
+ $blksize, $blocks) = stat($file);
+ open(IFILE, "$file");
+ open(OFILE, ">xl$$");
+ binmode OFILE || die "binmode xl$$: $!\n";
+ while (<IFILE>) {
+ print OFILE;
+ }
+ close(OFILE) || die "close xl$$: $!\n";
+ close(IFILE) || die "close $file: $!\n";
+ unlink($file) || die "unlink $file: $!\n";
+ rename("xl$$", $file) || die "rename(xl$$, $file): $!\n";
+ chmod($mode, $file) || die "chmod($mode, $file: $!\n";
+ utime($atime, $mtime, $file) || die "utime($atime, $mtime, $file): $!\n";
+ }
+ }
Index: msdos/msdos.c
*** msdos/msdos.c.old Tue Mar 27 16:40:51 1990
--- msdos/msdos.c Tue Mar 27 16:40:52 1990
***************
*** 0 ****
--- 1,246 ----
+ /* $Header: msdos.c,v 3.0.1.1 90/03/27 16:10:41 lwall Locked $
+ *
+ * (C) Copyright 1989, 1990 Diomidis Spinellis.
+ *
+ * You may distribute under the terms of the GNU General Public License
+ * as specified in the README file that comes with the perl 3.0 kit.
+ *
+ * $Log: msdos.c,v $
+ * Revision 3.0.1.1 90/03/27 16:10:41 lwall
+ * patch16: MSDOS support
+ *
+ * Revision 1.1 90/03/18 20:32:01 dds
+ * Initial revision
+ *
+ */
+
+ /*
+ * Various Unix compatibility functions for MS-DOS.
+ */
+
+ #include <stdio.h>
+ #include <errno.h>
+ #include <dos.h>
+ #include <time.h>
+ #include <process.h>
+
+ #include "EXTERN.h"
+ #include "perl.h"
+
+ /*
+ * Interface to the MS-DOS ioctl system call.
+ * The function is encoded as follows:
+ * The lowest nibble of the function code goes to AL
+ * The two middle nibbles go to CL
+ * The high nibble goes to CH
+ *
+ * The return code is -1 in the case of an error and if successful
+ * for functions AL = 00, 09, 0a the value of the register DX
+ * for functions AL = 02 - 08, 0e the value of the register AX
+ * for functions AL = 01, 0b - 0f the number 0
+ *
+ * Notice that this restricts the ioctl subcodes stored in AL to 00-0f
+ * In the Ralf Borwn interrupt list 90.1 there are no subcodes above AL=0f
+ * so we are ok.
+ * Furthermore CH is also restriced in the same area. Where CH is used as a
+ * code it always is between 00-0f. In the case where it forms a count
+ * together with CL we arbitrarily set the highest count limit to 4095. It
+ * sounds reasonable for an ioctl.
+ * The other alternative would have been to use the pointer argument to
+ * point the the values of CX. The problem with this approach is that
+ * of accessing wild regions when DX is used as a number and not as a
+ * pointer.
+ */
+ int
+ ioctl(int handle, unsigned int function, char *data)
+ {
+ union REGS srv;
+ struct SREGS segregs;
+
+ srv.h.ah = 0x44;
+ srv.h.al = function & 0xf;
+ srv.x.bx = handle;
+ srv.x.cx = function >> 4;
+ segread(&segregs);
+ #if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
+ segregs.ds = FP_SEG(data);
+ srv.x.dx = FP_OFF(data);
+ #else
+ srv.x.dx = (unsigned int) data;
+ #endif
+ intdosx(&srv, &srv, &segregs);
+ if (srv.x.cflag & 1) {
+ switch(srv.x.ax ){
+ case 1:
+ errno = EINVAL;
+ break;
+ case 2:
+ case 3:
+ errno = ENOENT;
+ break;
+ case 4:
+ errno = EMFILE;
+ break;
+ case 5:
+ errno = EPERM;
+ break;
+ case 6:
+ errno = EBADF;
+ break;
+ case 8:
+ errno = ENOMEM;
+ break;
+ case 0xc:
+ case 0xd:
+ case 0xf:
+ errno = EINVAL;
+ break;
+ case 0x11:
+ errno = EXDEV;
+ break;
+ case 0x12:
+ errno = ENFILE;
+ break;
+ default:
+ errno = EZERO;
+ break;
+ }
+ return -1;
+ } else {
+ switch (function & 0xf) {
+ case 0: case 9: case 0xa:
+ return srv.x.dx;
+ case 2: case 3: case 4: case 5:
+ case 6: case 7: case 8: case 0xe:
+ return srv.x.ax;
+ case 1: case 0xb: case 0xc: case 0xd:
+ case 0xf:
+ default:
+ return 0;
+ }
+ }
+ }
+
+
+ /*
+ * Sleep function.
+ */
+ void
+ sleep(unsigned len)
+ {
+ time_t end;
+
+ end = time((time_t *)0) + len;
+ while (time((time_t *)0) < end)
+ ;
+ }
+
+ /*
+ * Just pretend that everyone is a superuser
+ */
+ int
+ getuid(void)
+ {
+ return 0;
+ }
+
+ int
+ geteuid(void)
+ {
+ return 0;
+ }
+
+ int
+ getgid(void)
+ {
+ return 0;
+ }
+
+ int
+ getegid(void)
+ {
+ return 0;
+ }
+
+ /*
+ * The following code is based on the do_exec and do_aexec functions
+ * in file doio.c
+ */
+ int
+ do_aspawn(really,arglast)
+ STR *really;
+ int *arglast;
+ {
+ register STR **st = stack->ary_array;
+ register int sp = arglast[1];
+ register int items = arglast[2] - sp;
+ register char **a;
+ char **argv;
+ char *tmps;
+ int status;
+
+ if (items) {
+ New(1101,argv, items+1, char*);
+ a = argv;
+ for (st += ++sp; items > 0; items--,st++) {
+ if (*st)
+ *a++ = str_get(*st);
+ else
+ *a++ = "";
+ }
+ *a = Nullch;
+ if (really && *(tmps = str_get(really)))
+ status = spawnvp(P_WAIT,tmps,argv);
+ else
+ status = spawnvp(P_WAIT,argv[0],argv);
+ Safefree(argv);
+ }
+ return status;
+ }
+
+ char *getenv(char *name);
+
+ int
+ do_spawn(cmd)
+ char *cmd;
+ {
+ register char **a;
+ register char *s;
+ char **argv;
+ char flags[10];
+ int status;
+ char *shell, *cmd2;
+
+ /* save an extra exec if possible */
+ if ((shell = getenv("COMSPEC")) == 0)
+ shell = "\\command.com";
+
+ /* see if there are shell metacharacters in it */
+ if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|'))
+ doshell:
+ return spawnl(P_WAIT,shell,shell,"/c",cmd,(char*)0);
+
+ New(1102,argv, strlen(cmd) / 2 + 2, char*);
+
+ New(1103,cmd2, strlen(cmd) + 1, char);
+ strcpy(cmd2, cmd);
+ a = argv;
+ for (s = cmd2; *s;) {
+ while (*s && isspace(*s)) s++;
+ if (*s)
+ *(a++) = s;
+ while (*s && !isspace(*s)) s++;
+ if (*s)
+ *s++ = '\0';
+ }
+ *a = Nullch;
+ if (argv[0])
+ if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) {
+ Safefree(argv);
+ Safefree(cmd2);
+ goto doshell;
+ }
+ Safefree(cmd2);
+ Safefree(argv);
+ return status;
+ }
*** End of Patch 17 ***
Technical Details
Message-ID:
<7579@jpl-devvax.JPL.NASA.GOV>Path:
arc1-ca.pugleaf.net!utzoo!attcan!uunet!samsung!usc!elroy.jpl.nasa.gov!jpl-devvax!lwallShow Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!attcan!uunet!samsung!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 #17 Summary: This is an official patch for perl 3.0. Please apply it. Message-ID: <7579@jpl-devvax.JPL.NASA.GOV> Date: 28 Mar 90 18:21:52 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 2109