From: Larry Wall Date: Tue, 27 Mar 1990 04:26:14 +0000 (+0000) Subject: perl 3.0 patch #17 patch #16, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b1248f16cd8cccfb12ae16cd8e7e93dd53dc52bf;p=p5sagit%2Fp5-mst-13.2.git perl 3.0 patch #17 patch #16, continued See patch #16. --- diff --git a/config.h.SH b/config.h.SH index 7215ef9..7af917f 100644 --- a/config.h.SH +++ b/config.h.SH @@ -83,6 +83,12 @@ sed <config.h -e 's!^#undef!/\*#undef!' */ #$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 diff --git a/consarg.c b/consarg.c index 3ad6655..b918448 100644 --- a/consarg.c +++ b/consarg.c @@ -1,4 +1,4 @@ -/* $Header: consarg.c,v 3.0.1.4 90/03/12 16:24:40 lwall Locked $ +/* $Header: consarg.c,v 3.0.1.5 90/03/27 15:36:45 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * 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,7 +341,7 @@ register ARG *arg; str_numset(str,str_gnum(s1) / value); break; case O_MODULO: - tmplong = (long)str_gnum(s2); + tmplong = (unsigned long)str_gnum(s2); if (tmplong == 0L) { yyerror("Illegal modulus of constant zero"); break; @@ -407,19 +410,19 @@ register ARG *arg; case O_BIT_AND: value = str_gnum(s1); #ifndef lint - str_numset(str,(double)(((long)value) & ((long)str_gnum(s2)))); + 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)(((long)value) ^ ((long)str_gnum(s2)))); + 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)(((long)value) | ((long)str_gnum(s2)))); + str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2)))); #endif break; case O_AND: @@ -455,7 +458,7 @@ register ARG *arg; break; case O_COMPLEMENT: #ifndef lint - str_numset(str,(double)(~(long)str_gnum(s1))); + str_numset(str,(double)(~U_L(str_gnum(s1)))); #endif break; case O_SIN: diff --git a/doarg.c b/doarg.c index c13b17c..029ba38 100644 --- a/doarg.c +++ b/doarg.c @@ -1,4 +1,4 @@ -/* $Header: doarg.c,v 3.0.1.4 90/03/12 16:28:42 lwall Locked $ +/* $Header: doarg.c,v 3.0.1.5 90/03/27 15:39:03 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * 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,6 +46,10 @@ extern unsigned char fold[]; int wantarray; +#ifdef BUGGY_MSC + #pragma function(memcmp) +#endif /* BUGGY_MSC */ + int do_subst(str,arg,sp) STR *str; @@ -289,6 +298,9 @@ nope: 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,7 +460,7 @@ int *arglast; case 'I': while (len-- > 0) { fromstr = NEXTFROM; - auint = (unsigned int)str_gnum(fromstr); + auint = U_I(str_gnum(fromstr)); str_ncat(str,(char*)&auint,sizeof(unsigned int)); } break; @@ -472,7 +484,7 @@ int *arglast; case 'L': while (len-- > 0) { fromstr = NEXTFROM; - aulong = (unsigned long)str_gnum(fromstr); + aulong = U_L(str_gnum(fromstr)); str_ncat(str,(char*)&aulong,sizeof(unsigned long)); } break; @@ -511,10 +523,11 @@ register STR **sarg; char *xs; int xlen; double value; + char *origs; str_set(str,""); len--; /* don't count pattern string */ - s = str_get(*sarg); + origs = s = str_get(*sarg); send = s + (*sarg)->str_cur; sarg++; for ( ; s < send; len--) { @@ -578,19 +591,10 @@ register STR **sarg; 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); + (void)sprintf(buf,s,U_L(value)); else - (void)sprintf(buf,s,(unsigned int)value); + (void)sprintf(buf,s,U_I(value)); s = t; *(t--) = ch; break; @@ -616,10 +620,17 @@ register STR **sarg; 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 + 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,7 +1176,7 @@ STR *str; register int offset; register int size; register unsigned char *s = (unsigned char*)mstr->str_ptr; - register unsigned long lval = (unsigned long)str_gnum(str); + register unsigned long lval = U_L(str_gnum(str)); int mask; mstr->str_rare = 0; diff --git a/doio.c b/doio.c index e19a6f2..7667e5c 100644 --- a/doio.c +++ b/doio.c @@ -1,4 +1,4 @@ -/* $Header: doio.c,v 3.0.1.7 90/03/14 12:26:24 lwall Locked $ +/* $Header: doio.c,v 3.0.1.8 90/03/27 15:44:02 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * 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,8 +288,10 @@ register STAB *stab; #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,6 +307,7 @@ register STAB *stab; return Nullfp; } +#ifdef PIPE void do_pipe(str, rstab, wstab) STR *str; @@ -342,6 +350,7 @@ badexit: str_sset(str,&str_undef); return; } +#endif bool do_close(stab,explicit) @@ -361,7 +370,7 @@ bool explicit; if (stio->type == '|') { status = mypclose(stio->ifp); retval = (status >= 0); - statusvalue = (unsigned)status & 0xffff; + statusvalue = (unsigned short)status & 0xffff; } else if (stio->type == '-') retval = TRUE; @@ -897,6 +906,7 @@ char *cmd; register char *s; char **argv; char flags[10]; + char *cmd2; #ifdef TAINT taintenv(); @@ -949,9 +959,9 @@ char *cmd; } } New(402,argv, (s - cmd) / 2 + 2, char*); - + cmd2 = nsavestr(cmd, s-cmd); a = argv; - for (s = cmd; *s;) { + for (s = cmd2; *s;) { while (*s && isspace(*s)) s++; if (*s) *(a++) = s; @@ -962,9 +972,13 @@ char *cmd; *a = Nullch; if (argv[0]) { execvp(argv[0],argv); - if (errno == ENOEXEC) /* for system V NIH syndrome */ + if (errno == ENOEXEC) { /* for system V NIH syndrome */ + Safefree(argv); + Safefree(cmd2); goto doshell; + } } + Safefree(cmd2); Safefree(argv); return FALSE; } @@ -1944,6 +1958,7 @@ int *arglast; } } break; +#ifdef CHOWN case O_CHOWN: #ifdef TAINT taintproper("Insecure dependency in chown"); @@ -1959,6 +1974,8 @@ int *arglast; } } break; +#endif +#ifdef KILL case O_KILL: #ifdef TAINT taintproper("Insecure dependency in kill"); @@ -1994,6 +2011,7 @@ int *arglast; } } break; +#endif case O_UNLINK: #ifdef TAINT taintproper("Insecure dependency in unlink"); diff --git a/dolist.c b/dolist.c index 2d8ec59..0e74a56 100644 --- a/dolist.c +++ b/dolist.c @@ -1,4 +1,4 @@ -/* $Header: dolist.c,v 3.0.1.6 90/03/12 16:33:02 lwall Locked $ +/* $Header: dolist.c,v 3.0.1.7 90/03/27 15:48:42 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,13 @@ * 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,6 +50,10 @@ #include "perl.h" +#ifdef BUGGY_MSC + #pragma function(memcmp) +#endif /* BUGGY_MSC */ + int do_match(str,arg,gimme,arglast) STR *str; @@ -242,6 +253,8 @@ yup: 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,6 +275,10 @@ nope: return sp; } +#ifdef BUGGY_MSC + #pragma intrinsic(memcmp) +#endif /* BUGGY_MSC */ + int do_split(str,spat,limit,gimme,arglast) STR *str; @@ -846,6 +863,7 @@ int *arglast; 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,7 +974,10 @@ int *arglast; } arg = arg[1].arg_ptr.arg_arg; while (i-- > 0) { - stab_val(defstab) = st[src]; + 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,17 +1145,36 @@ int *arglast; { STR **st = stack->ary_array; register int sp = arglast[0]; - register int i = (int)str_gnum(st[sp+1]); + register int i; register ARRAY *ary = stack; register STR *str; - int max = (int)str_gnum(st[sp+2]); + int max; 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++); + 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; } diff --git a/dump.c b/dump.c index 778dc3b..c5f2a31 100644 --- a/dump.c +++ b/dump.c @@ -1,4 +1,4 @@ -/* $Header: dump.c,v 3.0 89/10/18 15:11:16 lwall Locked $ +/* $Header: dump.c,v 3.0.1.1 90/03/27 15:49:58 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * 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,7 +220,7 @@ register ARG *arg; dump_flags(b,flags) char *b; -unsigned flags; +unsigned int flags; { *b = '\0'; if (flags & AF_ARYOK) diff --git a/eval.c b/eval.c index 18ce86e..9978779 100644 --- a/eval.c +++ b/eval.c @@ -1,4 +1,4 @@ -/* $Header: eval.c,v 3.0.1.5 90/03/12 16:37:40 lwall Locked $ +/* $Header: eval.c,v 3.0.1.6 90/03/27 15:53:51 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * 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,6 +52,9 @@ #include +#ifdef I_FCNTL +#include +#endif #ifdef I_VFORK # include #endif @@ -289,14 +297,14 @@ register int sp; value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint - value = (double)(((unsigned long)value) << anum); + value = (double)(U_L(value) << anum); #endif goto donumset; case O_RIGHT_SHIFT: value = str_gnum(st[1]); anum = (int)str_gnum(st[2]); #ifndef lint - value = (double)(((unsigned long)value) >> anum); + value = (double)(U_L(value) >> anum); #endif goto donumset; case O_LT: @@ -332,8 +340,7 @@ register int sp; 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])); + value = (double)(U_L(value) & U_L(str_gnum(st[2]))); #endif goto donumset; } @@ -344,8 +351,7 @@ register int sp; 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])); + value = (double)(U_L(value) ^ U_L(str_gnum(st[2]))); #endif goto donumset; } @@ -356,8 +362,7 @@ register int sp; 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])); + value = (double)(U_L(value) | U_L(str_gnum(st[2]))); #endif goto donumset; } @@ -436,7 +441,7 @@ register int sp; goto donumset; case O_COMPLEMENT: #ifndef lint - value = (double) ~(unsigned long)str_gnum(st[1]); + value = (double) ~U_L(str_gnum(st[1])); #endif goto donumset; case O_SELECT: @@ -1330,27 +1335,32 @@ register int sp; } 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 - /* 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; +#else + fatal("Unsupported function wait"); + break; +#endif case O_SYSTEM: +#ifdef FORK #ifdef TAINT if (arglast[2] - arglast[1] == 1) { taintenv(); @@ -1392,6 +1402,16 @@ register int sp; 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,14 +1463,29 @@ register int sp; out: value = (double)anum; goto donumset; - case O_CHMOD: 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,6 +1497,10 @@ register int sp; 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,6 +1519,7 @@ register int sp; #endif goto donumset; case O_LINK: +#ifdef LINK tmps = str_get(st[1]); tmps2 = str_get(st[2]); #ifdef TAINT @@ -1487,6 +1527,10 @@ register int sp; #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,8 +1610,13 @@ register int sp; 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,6 +1667,7 @@ register int sp; break; #endif case O_CHROOT: +#ifdef CHROOT if (maxarg < 1) tmps = str_get(stab_val(defstab)); else @@ -1627,6 +1677,10 @@ register int sp; #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,15 +1689,17 @@ register int sp; stab = arg[1].arg_ptr.arg_stab; else stab = stabent(str_get(st[1]),TRUE); - argtype = (unsigned int)str_gnum(st[2]); + argtype = U_I(str_gnum(st[2])); #ifdef TAINT taintproper("Insecure dependency in ioctl"); #endif anum = do_ctl(optype,stab,argtype,st[3]); if (anum == -1) goto say_undef; - if (anum != 0) + if (anum != 0) { + value = (double)anum; goto donumset; + } str_set(str,"0 but true"); STABSET(str); break; @@ -1762,8 +1818,12 @@ register int sp; 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,7 +1862,7 @@ register int sp; value = (double)(symlink(tmps,tmps2) >= 0); goto donumset; #else - fatal("Unsupported function symlink()"); + fatal("Unsupported function symlink"); #endif case O_READLINK: #ifdef SYMLINK @@ -1816,16 +1876,28 @@ register int sp; str_nset(str,buf,anum); break; #else - fatal("Unsupported function readlink()"); + 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,12 +2130,29 @@ register int sp; 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; case O_GPWNAM: case O_GPWUID: case O_GPWENT: +#ifdef PASSWD sp = do_gpwent(optype, gimme,arglast); goto array_return; @@ -2073,9 +2162,16 @@ register int sp; 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,10 +2181,20 @@ register int sp; 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,6 +2214,7 @@ register int sp; 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,6 +2225,9 @@ register int sp; stab2 = stabent(str_get(st[2]),TRUE); do_pipe(str,stab,stab2); STABSET(str); +#else + fatal("Unsupported function pipe"); +#endif break; } diff --git a/evalargs.xc b/evalargs.xc index 76ac19a..711d9a9 100644 --- a/evalargs.xc +++ b/evalargs.xc @@ -2,9 +2,12 @@ * kit sizes from getting too big. */ -/* $Header: evalargs.xc,v 3.0.1.4 90/02/28 17:38:37 lwall Locked $ +/* $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,11 +252,15 @@ 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 +#endif /* !CSH */ +#endif /* !MSDOS */ goto do_read; case A_READ: last_in_stab = argptr.arg_stab; @@ -285,6 +292,11 @@ (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,7 +307,8 @@ str_scat(tmpstr,str); str_cat(tmpstr, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|"); -#endif +#endif /* !CSH */ +#endif /* !MSDOS */ (void)do_open(last_in_stab,tmpstr->str_ptr, tmpstr->str_cur); fp = stab_io(last_in_stab)->ifp; diff --git a/hash.c b/hash.c index 5f18937..e0b00ea 100644 --- a/hash.c +++ b/hash.c @@ -1,4 +1,4 @@ -/* $Header: hash.c,v 3.0.1.2 89/12/21 20:03:39 lwall Locked $ +/* $Header: hash.c,v 3.0.1.3 90/03/27 15:59:09 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * 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,12 +164,14 @@ register int hash; } #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; - hentfree(entry); /* no doubt they'll want this next. */ + hentdelayfree(entry); /* no doubt they'll want this next. */ entry = *oentry; } } @@ -317,6 +322,17 @@ register HENT *hent; } void +hentdelayfree(hent) +register HENT *hent; +{ + if (!hent) + return; + str_2static(hent->hent_val); /* free between statements */ + Safefree(hent->hent_key); + Safefree(hent); +} + +void hclear(tb) register HASH *tb; { diff --git a/lib/ctime.pl b/lib/ctime.pl new file mode 100644 index 0000000..d3b0354 --- /dev/null +++ b/lib/ctime.pl @@ -0,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; diff --git a/msdos/dir.h b/msdos/dir.h new file mode 100644 index 0000000..abda0c2 --- /dev/null +++ b/msdos/dir.h @@ -0,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 */ diff --git a/msdos/directory.c b/msdos/directory.c new file mode 100644 index 0000000..b435453 --- /dev/null +++ b/msdos/directory.c @@ -0,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); +} diff --git a/msdos/eg/crlf.bat b/msdos/eg/crlf.bat new file mode 100644 index 0000000..24d7366 --- /dev/null +++ b/msdos/eg/crlf.bat @@ -0,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"; + } +} diff --git a/msdos/eg/lf.bat b/msdos/eg/lf.bat new file mode 100644 index 0000000..9c13eef --- /dev/null +++ b/msdos/eg/lf.bat @@ -0,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"; + } +} diff --git a/msdos/glob.c b/msdos/glob.c new file mode 100644 index 0000000..19fb2ab --- /dev/null +++ b/msdos/glob.c @@ -0,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); + } +} diff --git a/msdos/msdos.c b/msdos/msdos.c new file mode 100644 index 0000000..7deb0aa --- /dev/null +++ b/msdos/msdos.c @@ -0,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; +} diff --git a/patchlevel.h b/patchlevel.h index 29d9127..6dbf069 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 16 +#define PATCHLEVEL 17