See patch #16.
*/
#$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
-/* $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
*
* 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
*
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;
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:
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:
-/* $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
*
* 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
int wantarray;
+#ifdef BUGGY_MSC
+ #pragma function(memcmp)
+#endif /* BUGGY_MSC */
+
int
do_subst(str,arg,sp)
STR *str;
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)
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;
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;
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--) {
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;
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;
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;
-/* $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
*
* 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
*
#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;
return Nullfp;
}
+#ifdef PIPE
void
do_pipe(str, rstab, wstab)
STR *str;
str_sset(str,&str_undef);
return;
}
+#endif
bool
do_close(stab,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;
register char *s;
char **argv;
char flags[10];
+ char *cmd2;
#ifdef TAINT
taintenv();
}
}
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;
*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;
}
}
}
break;
+#ifdef CHOWN
case O_CHOWN:
#ifdef TAINT
taintproper("Insecure dependency in chown");
}
}
break;
+#endif
+#ifdef KILL
case O_KILL:
#ifdef TAINT
taintproper("Insecure dependency in kill");
}
}
break;
+#endif
case O_UNLINK:
#ifdef TAINT
taintproper("Insecure dependency in unlink");
-/* $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
*
* 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)
#include "perl.h"
+#ifdef BUGGY_MSC
+ #pragma function(memcmp)
+#endif /* BUGGY_MSC */
+
int
do_match(str,arg,gimme,arglast)
STR *str;
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;
return sp;
}
+#ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+#endif /* BUGGY_MSC */
+
int
do_split(str,spat,limit,gimme,arglast)
STR *str;
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;
}
}
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]))
{
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;
}
-/* $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
*
* 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
*
dump_flags(b,flags)
char *b;
-unsigned flags;
+unsigned int flags;
{
*b = '\0';
if (flags & AF_ARYOK)
-/* $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
*
* 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]
#include <signal.h>
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
#ifdef I_VFORK
# include <vfork.h>
#endif
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:
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;
}
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;
}
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;
}
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:
}
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();
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);
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);
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]);
#endif
goto donumset;
case O_LINK:
+#ifdef LINK
tmps = str_get(st[1]);
tmps2 = str_get(st[2]);
#ifdef TAINT
#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]);
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)
break;
#endif
case O_CHROOT:
+#ifdef CHROOT
if (maxarg < 1)
tmps = str_get(stab_val(defstab));
else
#endif
value = (double)(chroot(tmps) >= 0);
goto donumset;
+#else
+ fatal("Unsupported function chroot");
+ break;
+#endif
case O_FCNTL:
case O_IOCTL:
if (maxarg <= 0)
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;
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;
value = (double)(symlink(tmps,tmps2) >= 0);
goto donumset;
#else
- fatal("Unsupported function symlink()");
+ fatal("Unsupported function symlink");
#endif
case O_READLINK:
#ifdef SYMLINK
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;
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;
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;
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:
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
stab2 = stabent(str_get(st[2]),TRUE);
do_pipe(str,stab,stab2);
STABSET(str);
+#else
+ fatal("Unsupported function pipe");
+#endif
break;
}
* 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
*
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;
(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 ");
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;
-/* $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
*
* 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
*
}
#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;
}
}
}
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;
{
--- /dev/null
+;# 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;
--- /dev/null
+/* $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 */
--- /dev/null
+/* $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);
+}
--- /dev/null
+@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";
+ }
+}
--- /dev/null
+@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";
+ }
+}
--- /dev/null
+/*
+ * 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);
+ }
+}
--- /dev/null
+/* $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;
+}
-#define PATCHLEVEL 16
+#define PATCHLEVEL 17
projects / p5sagit/p5-mst-13.2.git / commitdiff