lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (03/29/90)
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 ***