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 #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 # 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 + #include + #include + #include + #include + #include + #include + + /* + * 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 + #ifdef I_FCNTL + #include + #endif #ifdef I_VFORK # include #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 + #include + + 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 = ) { + $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 () { + 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 = ) { + $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 () { + 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 + #include + #include + #include + #include + + #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 ***