From: Larry Wall <lwall@netlabs.com>
Date: Mon, 8 Jun 1992 04:52:56 +0000 (+0000)
Subject: perl 4.0 patch 25: patch #20, continued
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8adcabd8d9cf3c71e660c45cb7165ae4694308d4;p=p5sagit%2Fp5-mst-13.2.git
perl 4.0 patch 25: patch #20, continued
See patch #20.
---
diff --git a/atarist/explain b/atarist/explain
new file mode 100644
index 0000000..9e8fca0
--- /dev/null
+++ b/atarist/explain
@@ -0,0 +1,77 @@
+Here is a brief explaination of the diffs in perl.diffs. If anything
+is unclear please just ask:
+
+General:
+ Many of the #ifdef MSDOS where required for the atari too. In order
+to avoid cluttering up the source, upfront in perl.h we #define
+MSDOS_OR_ATARI if either defined(MSDOS) or defined(atarist).
+
+ Some of the diffs that i felt were universally applicable are not protected
+with #ifdef's. In the explainations below i has indicated all such
+changes.
+
+perl.h:
+ -- define MSDOS_OR_ATARI if appro.
+ -- typedef size_t - assume its there in <stddef.h> if STANDARD_C otherwise
+ typedef it to unsigned int (i would have ideally liked unsigned long,
+ but we get into trouble with half-assed headers from sun etc)
+(this change not protected with a #ifdef since hopefully its universally appli)
+
+ -- make the type of STRLEN size_t for all systems
+(this change not protected with a #ifdef since hopefully its universally appli)
+
+ -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes.
+
+arg.h:
+ -- in the atari headers we already have O_PIPE. Change all instances of
+ O_PIPE to PERL_O_PIPE. All such changes protected with #ifdef atarist.
+
+handy.h:
+ -- make MEM_SIZE size_t like STRLEN.
+(this change not protected with a #ifdef since hopefully its universally appli)
+
+doarg.c:
+ -- accomodate the large number of args needed for the atari syscall().
+ -- do the 9 thru 14 arg versions of syscall for the atarist.
+
+doio.c:
+ -- mode[] needed to be initialized.
+(this change not protected with a #ifdef since hopefully its universally appli)
+
+ -- you may find this strange, we do not define STDSTDIO, because even
+ though we have the "standard" field in FILE, the semantics are
+ different. However, some contexts will work correctly, and there
+ you will see #if defined(STDSTDIO) || defined(atarist)
+
+ -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes.
+
+eval.c:
+ -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes.
+
+malloc.c::
+ -- instead of bashfully using ints to hold sizes use MEM_SIZE.
+ adjust some casts and printf format specifiers due to this.
+ (atarigcc can run in two modes, with 16 or 32 bit ints, so...)
+(this change not protected with a #ifdef since hopefully its universally appli)
+
+ -- atarist changes sometimes ||'ed with I286 as appro.
+
+perl.c:
+ -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes.
+
+regcomp.c:
+ -- like O_PIPE the atarist headers already has META defined. Change all
+ instances of META to PERL_META. All such changes protected with
+ #ifdef atarist.
+
+str.c:
+ -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes.
+
+token.c::
+ -- META -> PERL_META renaming for atari
+
+util.c::
+ -- more adjustments for memory sizes being MEM_SIZE instead of int.
+ -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes.
+
+++jrb bammi@cadence.com
diff --git a/atarist/test/dbm b/atarist/test/dbm
new file mode 100644
index 0000000..b73e07d
--- /dev/null
+++ b/atarist/test/dbm
@@ -0,0 +1,124 @@
+die "cant create dbmtest" unless dbmopen(%keys, "dbmtest", 0666);
+
+print "Writing...\n";
+$keys{'key0'} = 0;
+$keys{'key1'} = 1;
+$keys{'key2'} = 2;
+$keys{'key3'} = 3;
+$keys{'key4'} = 4;
+$keys{'key5'} = 5;
+$keys{'key6'} = 6;
+$keys{'key7'} = 7;
+$keys{'key8'} = 8;
+$keys{'key9'} = 9;
+$keys{'key10'} = 10;
+$keys{'key11'} = 11;
+$keys{'key12'} = 12;
+$keys{'key13'} = 13;
+$keys{'key14'} = 14;
+$keys{'key15'} = 15;
+$keys{'key16'} = 16;
+$keys{'key17'} = 17;
+$keys{'key18'} = 18;
+$keys{'key19'} = 19;
+$keys{'key20'} = 20;
+$keys{'key21'} = 21;
+$keys{'key22'} = 22;
+$keys{'key23'} = 23;
+$keys{'key24'} = 24;
+$keys{'key25'} = 25;
+$keys{'key26'} = 26;
+$keys{'key27'} = 27;
+$keys{'key28'} = 28;
+$keys{'key29'} = 29;
+$keys{'key30'} = 30;
+$keys{'key31'} = 31;
+$keys{'key32'} = 32;
+$keys{'key33'} = 33;
+$keys{'key34'} = 34;
+$keys{'key35'} = 35;
+$keys{'key36'} = 36;
+$keys{'key37'} = 37;
+$keys{'key38'} = 38;
+$keys{'key39'} = 39;
+$keys{'key40'} = 40;
+$keys{'key41'} = 41;
+$keys{'key42'} = 42;
+$keys{'key43'} = 43;
+$keys{'key44'} = 44;
+$keys{'key45'} = 45;
+$keys{'key46'} = 46;
+$keys{'key47'} = 47;
+$keys{'key48'} = 48;
+$keys{'key49'} = 49;
+$keys{'key50'} = 50;
+$keys{'key51'} = 51;
+$keys{'key52'} = 52;
+$keys{'key53'} = 53;
+$keys{'key54'} = 54;
+$keys{'key55'} = 55;
+$keys{'key56'} = 56;
+$keys{'key57'} = 57;
+$keys{'key58'} = 58;
+$keys{'key59'} = 59;
+$keys{'key60'} = 60;
+$keys{'key61'} = 61;
+$keys{'key62'} = 62;
+$keys{'key63'} = 63;
+$keys{'key64'} = 64;
+$keys{'key65'} = 65;
+$keys{'key66'} = 66;
+$keys{'key67'} = 67;
+$keys{'key68'} = 68;
+$keys{'key69'} = 69;
+$keys{'key70'} = 70;
+$keys{'key71'} = 71;
+$keys{'key72'} = 72;
+$keys{'key73'} = 73;
+$keys{'key74'} = 74;
+$keys{'key75'} = 75;
+$keys{'key76'} = 76;
+$keys{'key77'} = 77;
+$keys{'key78'} = 78;
+$keys{'key79'} = 79;
+$keys{'key80'} = 80;
+$keys{'key81'} = 81;
+$keys{'key82'} = 82;
+$keys{'key83'} = 83;
+$keys{'key84'} = 84;
+$keys{'key85'} = 85;
+$keys{'key86'} = 86;
+$keys{'key87'} = 87;
+$keys{'key88'} = 88;
+$keys{'key89'} = 89;
+$keys{'key90'} = 90;
+$keys{'key91'} = 91;
+$keys{'key92'} = 92;
+$keys{'key93'} = 93;
+$keys{'key94'} = 94;
+$keys{'key95'} = 95;
+$keys{'key96'} = 96;
+$keys{'key97'} = 97;
+$keys{'key98'} = 98;
+$keys{'key99'} = 99;
+$keys{'key9998'} = 9998;
+$keys{'key9999'} = 9999;
+print "Done\n";
+
+dbmclose (%keys);
+
+die "cant read dbmtest" unless dbmopen(%rkeys, "dbmtest", undef);
+
+$i = 0;
+print "Reading...\n";
+while (($key, $val) = each %rkeys)
+{
+ if ($keys{$key} != $val)
+ {
+ print 'Incorrect val ', $key, ' = ', $val, ' expecting ', $keys{$key}, "\n";
+ $i = $i + 1;
+ }
+}
+print "Done\n";
+dbmclose (%keys);
+print $i, "Error(s)\n";
diff --git a/cons.c b/cons.c
index a3572b3..54fa14d 100644
--- a/cons.c
+++ b/cons.c
@@ -1,4 +1,4 @@
-/* $RCSfile: cons.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 16:15:13 $
+/* $RCSfile: cons.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 12:18:35 $
*
* Copyright (c) 1991, Larry Wall
*
@@ -6,6 +6,16 @@
* License or the Artistic License, as specified in the README file.
*
* $Log: cons.c,v $
+ * Revision 4.0.1.3 92/06/08 12:18:35 lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: deleted some minor memory leaks
+ * patch20: fixed double debug break in foreach with implicit array assignment
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: Perl now distinguishes overlapped copies from non-overlapped
+ * patch20: debugger sometimes displayed wrong source line
+ * patch20: various error messages have been clarified
+ * patch20: an eval block containing a null block or statement could dump core
+ *
* Revision 4.0.1.2 91/11/05 16:15:13 lwall
* patch11: debugger got confused over nested subroutine definitions
* patch11: prepared for ctype implementations that don't define isascii()
@@ -29,6 +39,8 @@ extern int yychar;
static int cmd_tosave();
static int arg_tosave();
static int spat_tosave();
+static void make_cswitch();
+static void make_nswitch();
static bool saw_return;
@@ -40,8 +52,7 @@ CMD *cmd;
register SUBR *sub;
STAB *stab = stabent(name,TRUE);
- Newz(101,sub,1,SUBR);
- if (stab_sub(stab)) {
+ if (sub = stab_sub(stab)) {
if (dowarn) {
CMD *oldcurcmd = curcmd;
@@ -50,13 +61,14 @@ CMD *cmd;
warn("Subroutine %s redefined",name);
curcmd = oldcurcmd;
}
- if (stab_sub(stab)->cmd) {
- cmd_free(stab_sub(stab)->cmd);
- stab_sub(stab)->cmd = Nullcmd;
- afree(stab_sub(stab)->tosave);
+ if (!sub->usersub && sub->cmd) {
+ cmd_free(sub->cmd);
+ sub->cmd = Nullcmd;
+ afree(sub->tosave);
}
- Safefree(stab_sub(stab));
+ Safefree(sub);
}
+ Newz(101,sub,1,SUBR);
stab_sub(stab) = sub;
sub->filestab = curcmd->c_filestab;
saw_return = FALSE;
@@ -69,7 +81,8 @@ CMD *cmd;
mycompblock.comp_true = cmd;
mycompblock.comp_alt = Nullcmd;
- cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
+ cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,0,
+ Nullarg,mycompblock));
saw_return = FALSE;
cmd->c_flags |= CF_TERM;
}
@@ -83,10 +96,10 @@ CMD *cmd;
str_cat(str,"-");
sprintf(buf,"%ld",(long)curcmd->c_line);
str_cat(str,buf);
- name = str_get(subname);
- stab_fullname(tmpstr,stab);
+ stab_efullname(tmpstr,stab);
hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
}
+ Safefree(name);
return sub;
}
@@ -102,17 +115,17 @@ char *filename;
if (!stab) /* unused function */
return Null(SUBR*);
- Newz(101,sub,1,SUBR);
- if (stab_sub(stab)) {
+ if (sub = stab_sub(stab)) {
if (dowarn)
warn("Subroutine %s redefined",name);
- if (stab_sub(stab)->cmd) {
- cmd_free(stab_sub(stab)->cmd);
- stab_sub(stab)->cmd = Nullcmd;
- afree(stab_sub(stab)->tosave);
+ if (!sub->usersub && sub->cmd) {
+ cmd_free(sub->cmd);
+ sub->cmd = Nullcmd;
+ afree(sub->tosave);
}
- Safefree(stab_sub(stab));
+ Safefree(sub);
}
+ Newz(101,sub,1,SUBR);
stab_sub(stab) = sub;
sub->filestab = fstab(filename);
sub->usersub = subaddr;
@@ -120,6 +133,7 @@ char *filename;
return sub;
}
+void
make_form(stab,fcmd)
STAB *stab;
FCMD *fcmd;
@@ -188,11 +202,6 @@ register CMD *tail;
/* now do a little optimization on case-ish structures */
switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
case CFT_ANCHOR:
- if (stabent("*",FALSE)) { /* bad assumption here!!! */
- opt = 0;
- break;
- }
- /* FALL THROUGH */
case CFT_STROP:
opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
break;
@@ -239,6 +248,7 @@ register CMD *tail;
* spat. Thus we can insert a SWITCH in front and jump directly
* to the correct one.
*/
+static void
make_cswitch(head,count)
register CMD *head;
int count;
@@ -251,12 +261,9 @@ int count;
/* make a new head in the exact same spot */
New(102,cur, 1, CMD);
-#ifdef STRUCTCOPY
- *cur = *head;
-#else
- Copy(head,cur,1,CMD);
-#endif
+ StructCopy(head,cur,CMD);
Zero(head,1,CMD);
+ head->c_head = cur->c_head;
head->c_type = C_CSWITCH;
head->c_next = cur; /* insert new cmd at front of list */
head->c_stab = cur->c_stab;
@@ -289,7 +296,7 @@ int count;
}
max++;
if (min > 0)
- Copy(&loc[min],&loc[0], max - min, CMD*);
+ Move(&loc[min],&loc[0], max - min, CMD*);
loc--;
min--;
max -= min;
@@ -302,6 +309,7 @@ int count;
head->ucmd.scmd.sc_next = loc;
}
+static void
make_nswitch(head,count)
register CMD *head;
int count;
@@ -339,12 +347,9 @@ int count;
/* now make a new head in the exact same spot */
New(104,cur, 1, CMD);
-#ifdef STRUCTCOPY
- *cur = *head;
-#else
- Copy(head,cur,1,CMD);
-#endif
+ StructCopy(head,cur,CMD);
Zero(head,1,CMD);
+ head->c_head = cur->c_head;
head->c_type = C_NSWITCH;
head->c_next = cur; /* insert new cmd at front of list */
head->c_stab = cur->c_stab;
@@ -443,6 +448,7 @@ CMD *cur;
stab2arg(A_WORD,DBstab),
Nullarg,
Nullarg);
+ /*SUPPRESS 53*/
cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
cmd->c_line = head->c_line;
cmd->c_label = head->c_label;
@@ -481,8 +487,9 @@ ARG *arg;
}
CMD *
-make_ccmd(type,arg,cblock)
+make_ccmd(type,debuggable,arg,cblock)
int type;
+int debuggable;
ARG *arg;
struct compcmd cblock;
{
@@ -503,7 +510,7 @@ struct compcmd cblock;
}
cmd->c_filestab = curcmd->c_filestab;
cmd->c_stash = curstash;
- if (perldb)
+ if (perldb && debuggable)
cmd = dodb(cmd);
return cmd;
}
@@ -545,7 +552,7 @@ struct compcmd cblock;
if (alt) { /* a real life ELSE at the end? */
ncblock.comp_true = alt;
ncblock.comp_alt = Nullcmd;
- alt = append_line(cur,make_ccmd(C_ELSE,Nullarg,ncblock));
+ alt = append_line(cur,make_ccmd(C_ELSE,1,Nullarg,ncblock));
cur->ucmd.ccmd.cc_alt = alt;
}
else
@@ -693,6 +700,7 @@ int acmd;
sure |= CF_EQSURE; /* (SUBST must be forced even */
/* if we know it will work.) */
if (arg->arg_type != O_SUBST) {
+ str_free(arg[2].arg_ptr.arg_spat->spat_short);
arg[2].arg_ptr.arg_spat->spat_short = Nullstr;
arg[2].arg_ptr.arg_spat->spat_slen = 0; /* only one chk */
}
@@ -901,6 +909,18 @@ CMD *cmd;
return cmd;
}
+void
+cpy7bit(d,s,l)
+register char *d;
+register char *s;
+register int l;
+{
+ while (l--)
+ *d++ = *s++ & 127;
+ *d = '\0';
+}
+
+int
yyerror(s)
char *s;
{
@@ -912,16 +932,14 @@ char *s;
oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
while (isSPACE(*oldoldbufptr))
oldoldbufptr++;
- strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
- tmp2buf[bufptr - oldoldbufptr] = '\0';
+ cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
}
else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
oldbufptr != bufptr) {
while (isSPACE(*oldbufptr))
oldbufptr++;
- strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
- tmp2buf[bufptr - oldbufptr] = '\0';
+ cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr);
sprintf(tname,"next token \"%s\"",tmp2buf);
}
else if (yychar > 256)
@@ -1101,7 +1119,7 @@ register CMD *cmd;
cmd->ucmd.ccmd.cc_alt = tail; /* every loop has a continue now */
#ifndef lint
- (void)bcopy((char *)cmd, (char *)tail, sizeof(CMD));
+ Copy((char *)cmd, (char *)tail, 1, CMD);
#endif
tail->c_type = C_EXPR;
tail->c_flags ^= CF_INVERT; /* turn into "last unless" */
@@ -1127,12 +1145,17 @@ register CMD *cmd;
return cmd;
}
+void
cmd_free(cmd)
register CMD *cmd;
{
register CMD *tofree;
register CMD *head = cmd;
+ if (!cmd)
+ return;
+ if (cmd->c_head != cmd)
+ warn("Malformed cmd links\n");
while (cmd) {
if (cmd->c_type != C_WHILE) { /* WHILE block is duplicated */
if (cmd->c_label) {
@@ -1175,11 +1198,14 @@ register CMD *cmd;
Safefree(head);
}
+void
arg_free(arg)
register ARG *arg;
{
register int i;
+ if (!arg)
+ return;
for (i = 1; i <= arg->arg_len; i++) {
switch (arg[i].arg_type & A_MASK) {
case A_NULL:
@@ -1231,12 +1257,15 @@ register ARG *arg;
free_arg(arg);
}
+void
spat_free(spat)
register SPAT *spat;
{
register SPAT *sp;
HENT *entry;
+ if (!spat)
+ return;
if (spat->spat_runtime) {
arg_free(spat->spat_runtime);
spat->spat_runtime = Nullarg;
diff --git a/doarg.c b/doarg.c
index c40bf68..01a9631 100644
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $RCSfile: doarg.c,v $$Revision: 4.0.1.5 $$Date: 91/11/11 16:31:58 $
+/* $RCSfile: doarg.c,v $$Revision: 4.0.1.6 $$Date: 92/06/08 12:34:30 $
*
* Copyright (c) 1991, Larry Wall
*
@@ -6,6 +6,16 @@
* License or the Artistic License, as specified in the README file.
*
* $Log: doarg.c,v $
+ * Revision 4.0.1.6 92/06/08 12:34:30 lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: pattern modifiers i and o didn't interact right
+ * patch20: join() now pre-extends target string to avoid excessive copying
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly
+ * patch20: usersub routines didn't reclaim temp values soon enough
+ * patch20: ($<,$>) = ... didn't work on some architectures
+ * patch20: added Atari ST portability
+ *
* Revision 4.0.1.5 91/11/11 16:31:58 lwall
* patch19: added little-endian pack/unpack options
*
@@ -53,6 +63,8 @@ extern unsigned char fold[];
#pragma function(memcmp)
#endif /* BUGGY_MSC */
+static void doencodes();
+
int
do_subst(str,arg,sp)
STR *str;
@@ -90,7 +102,8 @@ int sp;
spat->spat_regexp = regcomp(m,m+dstr->str_cur,
spat->spat_flags & SPAT_FOLD);
if (spat->spat_flags & SPAT_KEEP) {
- scanconst(spat, m, dstr->str_cur);
+ if (!(spat->spat_flags & SPAT_FOLD))
+ scanconst(spat, m, dstr->str_cur);
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
hoistmust(spat);
@@ -178,12 +191,12 @@ int sp;
s = orig;
if (m - s > strend - d) { /* faster to shorten from end */
if (clen) {
- (void)bcopy(c, m, clen);
+ Copy(c, m, clen, char);
m += clen;
}
i = strend - d;
if (i > 0) {
- (void)bcopy(d, m, i);
+ Move(d, m, i, char);
m += i;
}
*m = '\0';
@@ -202,7 +215,7 @@ int sp;
while (i--)
*--d = *--s;
if (clen)
- (void)bcopy(c, m, clen);
+ Copy(c, m, clen, char);
STABSET(str);
str_numset(arg->arg_ptr.arg_str, 1.0);
stack->ary_array[++sp] = arg->arg_ptr.arg_str;
@@ -211,7 +224,7 @@ int sp;
else if (clen) {
d -= clen;
str_chop(str,d);
- (void)bcopy(c,d,clen);
+ Copy(c,d,clen,char);
STABSET(str);
str_numset(arg->arg_ptr.arg_str, 1.0);
stack->ary_array[++sp] = arg->arg_ptr.arg_str;
@@ -233,11 +246,11 @@ int sp;
/*SUPPRESS 560*/
if (i = m - s) {
if (s != d)
- (void)bcopy(s,d,i);
+ Move(s,d,i,char);
d += i;
}
if (clen) {
- (void)bcopy(c,d,clen);
+ Copy(c,d,clen,char);
d += clen;
}
s = spat->spat_regexp->endp[0];
@@ -246,7 +259,7 @@ int sp;
if (s != d) {
i = strend - s;
str->str_cur = d - str->str_ptr + i;
- (void)bcopy(s,d,i+1); /* include the Null */
+ Move(s,d,i+1,char); /* include the Null */
}
STABSET(str);
str_numset(arg->arg_ptr.arg_str, (double)iters);
@@ -385,19 +398,35 @@ register STR *str;
int *arglast;
{
register STR **st = stack->ary_array;
- register int sp = arglast[1];
+ int sp = arglast[1];
register int items = arglast[2] - sp;
register char *delim = str_get(st[sp]);
+ register STRLEN len;
int delimlen = st[sp]->str_cur;
- st += ++sp;
+ st += sp + 1;
+
+ len = delimlen * (items - 1);
+ if (str->str_len < len + items) { /* current length is way too short */
+ while (items-- > 0) {
+ if (*st)
+ len += (*st)->str_cur;
+ st++;
+ }
+ STR_GROW(str, len + 1); /* so try to pre-extend */
+
+ items = arglast[2] - sp;
+ st -= items;
+ }
+
if (items-- > 0)
str_sset(str, *st++);
else
str_set(str,"");
- if (delimlen) {
+ len = delimlen;
+ if (len) {
for (; items > 0; items--,st++) {
- str_ncat(str,delim,delimlen);
+ str_ncat(str,delim,len);
str_scat(str,*st);
}
}
@@ -780,6 +809,7 @@ int *arglast;
}
#undef NEXTFROM
+static void
doencodes(str, s, len)
register STR *str;
register char *s;
@@ -938,7 +968,7 @@ register STR **sarg;
&& xlen == sizeof(STBP)) {
STR *tmpstr = Str_new(24,0);
- stab_fullname(tmpstr, ((STAB*)arg)); /* a stab value! */
+ stab_efullname(tmpstr, ((STAB*)arg)); /* a stab value! */
sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
/* reformat to non-binary */
xs = tokenbuf;
@@ -1053,6 +1083,7 @@ int *arglast;
register int sp = arglast[1];
register int items = arglast[2] - sp;
register SUBR *sub;
+ SPAT * VOLATILE oldspat = curspat;
STR *str;
STAB *stab;
int oldsave = savestack->ary_fill;
@@ -1075,13 +1106,13 @@ int *arglast;
if (!(sub = stab_sub(stab))) {
STR *tmpstr = arg[0].arg_ptr.arg_str;
- stab_fullname(tmpstr, stab);
+ stab_efullname(tmpstr, stab);
fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
}
if (arg->arg_type == O_DBSUBR && !sub->usersub) {
str = stab_val(DBsub);
saveitem(str);
- stab_fullname(str,stab);
+ stab_efullname(str,stab);
sub = stab_sub(DBsub);
if (!sub)
fatal("No DBsub routine");
@@ -1098,6 +1129,7 @@ int *arglast;
csv->wantarray = gimme;
csv->hasargs = hasargs;
curcsv = csv;
+ tmps_base = tmps_max;
if (sub->usersub) {
csv->hasargs = 0;
csv->savearray = Null(ARRAY*);;
@@ -1105,28 +1137,30 @@ int *arglast;
st[sp] = arg->arg_ptr.arg_str;
if (!hasargs)
items = 0;
- return (*sub->usersub)(sub->userindex,sp,items);
- }
- if (hasargs) {
- csv->savearray = stab_xarray(defstab);
- csv->argarray = afake(defstab, items, &st[sp+1]);
- stab_xarray(defstab) = csv->argarray;
+ sp = (*sub->usersub)(sub->userindex,sp,items);
}
- sub->depth++;
- if (sub->depth >= 2) { /* save temporaries on recursion? */
- if (sub->depth == 100 && dowarn)
- warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
- savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
+ else {
+ if (hasargs) {
+ csv->savearray = stab_xarray(defstab);
+ csv->argarray = afake(defstab, items, &st[sp+1]);
+ stab_xarray(defstab) = csv->argarray;
+ }
+ sub->depth++;
+ if (sub->depth >= 2) { /* save temporaries on recursion? */
+ if (sub->depth == 100 && dowarn)
+ warn("Deep recursion on subroutine \"%s\"",stab_ename(stab));
+ savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
+ }
+ sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
}
- tmps_base = tmps_max;
- sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
- st = stack->ary_array;
+ st = stack->ary_array;
tmps_base = oldtmps_base;
for (items = arglast[0] + 1; items <= sp; items++)
st[items] = str_mortal(st[items]);
/* in case restore wipes old str */
restorelist(oldsave);
+ curspat = oldspat;
return sp;
}
@@ -1264,22 +1298,56 @@ int *arglast;
STABSET(str);
}
}
- if (delaymagic > 1) {
- if (delaymagic & DM_REUID) {
+ if (delaymagic & ~DM_DELAY) {
+ if (delaymagic & DM_UID) {
#ifdef HAS_SETREUID
- setreuid(uid,euid);
-#else
- if (uid != euid || setuid(uid) < 0)
- fatal("No setreuid available");
-#endif
+ (void)setreuid(uid,euid);
+#else /* not HAS_SETREUID */
+#ifdef HAS_SETRUID
+ if ((delaymagic & DM_UID) == DM_RUID) {
+ (void)setruid(uid);
+ delaymagic =~ DM_RUID;
+ }
+#endif /* HAS_SETRUID */
+#ifdef HAS_SETEUID
+ if ((delaymagic & DM_UID) == DM_EUID) {
+ (void)seteuid(uid);
+ delaymagic =~ DM_EUID;
+ }
+#endif /* HAS_SETEUID */
+ if (delaymagic & DM_UID) {
+ if (uid != euid)
+ fatal("No setreuid available");
+ (void)setuid(uid);
+ }
+#endif /* not HAS_SETREUID */
+ uid = (int)getuid();
+ euid = (int)geteuid();
}
- if (delaymagic & DM_REGID) {
+ if (delaymagic & DM_GID) {
#ifdef HAS_SETREGID
- setregid(gid,egid);
-#else
- if (gid != egid || setgid(gid) < 0)
- fatal("No setregid available");
-#endif
+ (void)setregid(gid,egid);
+#else /* not HAS_SETREGID */
+#ifdef HAS_SETRGID
+ if ((delaymagic & DM_GID) == DM_RGID) {
+ (void)setrgid(gid);
+ delaymagic =~ DM_RGID;
+ }
+#endif /* HAS_SETRGID */
+#ifdef HAS_SETEGID
+ if ((delaymagic & DM_GID) == DM_EGID) {
+ (void)setegid(gid);
+ delaymagic =~ DM_EGID;
+ }
+#endif /* HAS_SETEGID */
+ if (delaymagic & DM_GID) {
+ if (gid != egid)
+ fatal("No setregid available");
+ (void)setgid(gid);
+ }
+#endif /* not HAS_SETREGID */
+ gid = (int)getgid();
+ egid = (int)getegid();
}
}
delaymagic = 0;
@@ -1498,7 +1566,7 @@ int *arglast;
else {
if (len > str->str_cur) {
STR_GROW(str,len);
- (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
+ (void)memzero(str->str_ptr + str->str_cur, len - str->str_cur);
str->str_cur = len;
}
s = (unsigned char*)str_get(str);
@@ -1571,6 +1639,7 @@ STR *str;
}
}
+void
do_chop(astr,str)
register STR *astr;
register STR *str;
@@ -1610,6 +1679,7 @@ register STR *str;
str_nset(astr,"",0);
}
+void
do_vop(optype,str,left,right)
STR *str;
STR *left;
@@ -1627,7 +1697,7 @@ STR *right;
str->str_cur = len;
else if (str->str_cur < len) {
STR_GROW(str,len);
- (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
+ (void)memzero(str->str_ptr + str->str_cur, len - str->str_cur);
str->str_cur = len;
}
str->str_pok = 1;
@@ -1666,7 +1736,11 @@ int *arglast;
register STR **st = stack->ary_array;
register int sp = arglast[1];
register int items = arglast[2] - sp;
+#ifdef atarist
+ unsigned long arg[14]; /* yes, we really need that many ! */
+#else
unsigned long arg[8];
+#endif
register int i = 0;
int retval = -1;
@@ -1723,6 +1797,32 @@ int *arglast;
retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
arg[7]);
break;
+#ifdef atarist
+ case 9:
+ retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+ arg[7], arg[8]);
+ break;
+ case 10:
+ retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+ arg[7], arg[8], arg[9]);
+ break;
+ case 11:
+ retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+ arg[7], arg[8], arg[9], arg[10]);
+ break;
+ case 12:
+ retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+ arg[7], arg[8], arg[9], arg[10], arg[11]);
+ break;
+ case 13:
+ retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+ arg[7], arg[8], arg[9], arg[10], arg[11], arg[12]);
+ break;
+ case 14:
+ retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
+ arg[7], arg[8], arg[9], arg[10], arg[11], arg[12], arg[13]);
+ break;
+#endif /* atarist */
}
return retval;
#else
diff --git a/dump.c b/dump.c
index 273e6cc..f7abd02 100644
--- a/dump.c
+++ b/dump.c
@@ -1,4 +1,4 @@
-/* $RCSfile: dump.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:58:44 $
+/* $RCSfile: dump.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 13:14:22 $
*
* Copyright (c) 1991, Larry Wall
*
@@ -6,6 +6,10 @@
* License or the Artistic License, as specified in the README file.
*
* $Log: dump.c,v $
+ * Revision 4.0.1.2 92/06/08 13:14:22 lwall
+ * patch20: removed implicit int declarations on funcions
+ * patch20: fixed confusion between a *var's real name and its effective name
+ *
* Revision 4.0.1.1 91/06/07 10:58:44 lwall
* patch4: new copyright notice
*
@@ -20,6 +24,9 @@
#ifdef DEBUGGING
static int dumplvl = 0;
+static void dump();
+
+void
dump_all()
{
register int i;
@@ -40,6 +47,7 @@ dump_all()
}
}
+void
dump_cmd(cmd,alt)
register CMD *cmd;
register CMD *alt;
@@ -160,6 +168,7 @@ register CMD *alt;
}
}
+void
dump_arg(arg)
register ARG *arg;
{
@@ -231,6 +240,7 @@ register ARG *arg;
dump("}\n");
}
+void
dump_flags(b,flags)
char *b;
unsigned int flags;
@@ -256,6 +266,7 @@ unsigned int flags;
b[strlen(b)-1] = '\0';
}
+void
dump_stab(stab)
register STAB *stab;
{
@@ -269,11 +280,17 @@ register STAB *stab;
dumplvl++;
fprintf(stderr,"{\n");
stab_fullname(str,stab);
- dump("STAB_NAME = %s\n", str->str_ptr);
+ dump("STAB_NAME = %s", str->str_ptr);
+ if (stab != stab_estab(stab)) {
+ stab_efullname(str,stab_estab(stab));
+ dump("-> %s", str->str_ptr);
+ }
+ dump("\n");
dumplvl--;
dump("}\n");
}
+void
dump_spat(spat)
register SPAT *spat;
{
@@ -307,7 +324,7 @@ register SPAT *spat;
}
/* VARARGS1 */
-dump(arg1,arg2,arg3,arg4,arg5)
+static void dump(arg1,arg2,arg3,arg4,arg5)
char *arg1;
long arg2, arg3, arg4, arg5;
{
diff --git a/eval.c b/eval.c
index c8782e2..82b7a8b 100644
--- a/eval.c
+++ b/eval.c
@@ -1,4 +1,4 @@
-/* $RCSfile: eval.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:15:21 $
+/* $RCSfile: eval.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 13:20:20 $
*
* Copyright (c) 1991, Larry Wall
*
@@ -6,6 +6,16 @@
* License or the Artistic License, as specified in the README file.
*
* $Log: eval.c,v $
+ * Revision 4.0.1.4 92/06/08 13:20:20 lwall
+ * patch20: added explicit time_t support
+ * patch20: fixed confusion between a *var's real name and its effective name
+ * patch20: added Atari ST portability
+ * patch20: new warning for use of x with non-numeric right operand
+ * patch20: modulus with highest bit in left operand set didn't always work
+ * patch20: dbmclose(%array) didn't work
+ * patch20: added ... as variant on ..
+ * patch20: O_PIPE conflicted with Atari
+ *
* Revision 4.0.1.3 91/11/05 17:15:21 lwall
* patch11: prepared for ctype implementations that don't define isascii()
* patch11: various portability fixes
@@ -44,6 +54,11 @@
#ifdef I_FCNTL
#include <fcntl.h>
#endif
+#ifdef MSDOS
+/* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
+ but fcntl.h is required for O_BINARY */
+#include <fcntl.h>
+#endif
#ifdef I_SYS_FILE
#include <sys/file.h>
#endif
@@ -89,8 +104,10 @@ register int sp;
int argtype;
union argptr argptr;
int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */
- unsigned long tmplong;
- long when;
+ unsigned long tmpulong;
+ long tmplong;
+ time_t when;
+ STRLEN tmplen;
FILE *fp;
STR *tmpstr;
FCMD *form;
@@ -204,7 +221,8 @@ register int sp;
stab_io(stab) = stio_new();
#ifdef DEBUGGING
if (debug & 8) {
- (void)sprintf(buf,"STAR *%s",stab_name(argptr.arg_stab));
+ (void)sprintf(buf,"STAR *%s -> *%s",
+ stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
tmps = buf;
}
#endif
@@ -213,7 +231,8 @@ register int sp;
str = st[++sp] = (STR*)argptr.arg_stab;
#ifdef DEBUGGING
if (debug & 8) {
- (void)sprintf(buf,"LSTAR *%s",stab_name(argptr.arg_stab));
+ (void)sprintf(buf,"LSTAR *%s -> *%s",
+ stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab));
tmps = buf;
}
#endif
@@ -390,7 +409,7 @@ register int sp;
old_rschar = rschar;
old_rslen = rslen;
rslen = 1;
-#ifdef MSDOS
+#ifdef DOSISH
rschar = 0;
#else
#ifdef CSH
@@ -433,7 +452,7 @@ register int sp;
(void) interp(str,stab_val(last_in_stab),sp);
st = stack->ary_array;
tmpstr = Str_new(55,0);
-#ifdef MSDOS
+#ifdef DOSISH
str_set(tmpstr, "perlglob ");
str_scat(tmpstr,str);
str_cat(tmpstr," |");
@@ -458,9 +477,9 @@ register int sp;
}
}
if (!fp && dowarn)
- warn("Read on closed filehandle <%s>",stab_name(last_in_stab));
- when = str->str_len; /* remember if already alloced */
- if (!when)
+ warn("Read on closed filehandle <%s>",stab_ename(last_in_stab));
+ tmplen = str->str_len; /* remember if already alloced */
+ if (!tmplen)
Str_Grow(str,80); /* try short-buffering it */
keepgoing:
if (!fp)
@@ -520,7 +539,7 @@ register int sp;
str = Str_new(58,80);
goto keepgoing;
}
- else if (!when && str->str_len - str->str_cur > 80) {
+ else if (!tmplen && str->str_len - str->str_cur > 80) {
/* try to reclaim a bit of scalar space on 1st alloc */
if (str->str_cur < 60)
str->str_len = 80;
@@ -584,8 +603,8 @@ register int sp;
sp = do_repeatary(arglast);
goto array_return;
}
- STR_SSET(str,st[arglast[1] - arglast[0]]);
- anum = (int)str_gnum(st[arglast[2] - arglast[0]]);
+ STR_SSET(str,st[1]);
+ anum = (int)str_gnum(st[2]);
if (anum >= 1) {
tmpstr = Str_new(50, 0);
tmps = str_get(str);
@@ -598,8 +617,11 @@ register int sp;
str->str_nok = 0;
str_free(tmpstr);
}
- else
+ else {
+ if (dowarn && st[2]->str_pok && !looks_like_number(st[2]))
+ warn("Right operand of x is not numeric");
str_sset(str,&str_no);
+ }
STABSET(str);
break;
case O_MATCH:
@@ -724,15 +746,17 @@ register int sp;
#endif
goto donumset;
case O_MODULO:
- tmplong = (long) str_gnum(st[2]);
- if (tmplong == 0L)
+ tmpulong = (unsigned long) str_gnum(st[2]);
+ if (tmpulong == 0L)
fatal("Illegal modulus zero");
- when = (long)str_gnum(st[1]);
#ifndef lint
- if (when >= 0)
- value = (double)(when % tmplong);
- else
- value = (double)(tmplong - ((-when - 1) % tmplong)) - 1;
+ value = str_gnum(st[1]);
+ if (value >= 0.0)
+ value = (double)(((unsigned long)value) % tmpulong);
+ else {
+ tmplong = (long)value;
+ value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
+ }
#endif
goto donumset;
case O_ADD:
@@ -916,7 +940,7 @@ register int sp;
}
break;
case O_SELECT:
- stab_fullname(str,defoutstab);
+ stab_efullname(str,defoutstab);
if (maxarg > 0) {
if ((arg[1].arg_type & A_MASK) == A_WORD)
defoutstab = arg[1].arg_ptr.arg_stab;
@@ -989,7 +1013,8 @@ register int sp;
#endif
case O_DBMCLOSE:
#ifdef SOME_DBM
- if ((arg[1].arg_type & A_MASK) == A_WORD)
+ anum = arg[1].arg_type & A_MASK;
+ if (anum == A_WORD || anum == A_STAB)
stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
@@ -1074,7 +1099,7 @@ register int sp;
tmps = str_get(st[2]);
str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
if (tmpstab == envstab)
- setenv(tmps,Nullch);
+ my_setenv(tmps,Nullch);
if (!str)
goto say_undef;
break;
@@ -1656,7 +1681,7 @@ register int sp;
if (maxarg < 1)
(void)time(&when);
else
- when = (long)str_gnum(st[1]);
+ when = (time_t)str_gnum(st[1]);
sp = do_time(str,localtime(&when),
gimme,arglast);
goto array_return;
@@ -1664,7 +1689,7 @@ register int sp;
if (maxarg < 1)
(void)time(&when);
else
- when = (long)str_gnum(st[1]);
+ when = (time_t)str_gnum(st[1]);
sp = do_time(str,gmtime(&when),
gimme,arglast);
goto array_return;
@@ -1869,17 +1894,23 @@ register int sp;
last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
:
str_true(st[1]) ) {
- str_numset(str,0.0);
- anum = 2;
- arg->arg_type = optype = O_FLOP;
arg[2].arg_type &= ~A_DONT;
arg[1].arg_type |= A_DONT;
- argflags = arg[2].arg_flags;
- argtype = arg[2].arg_type & A_MASK;
- argptr = arg[2].arg_ptr;
- sp = arglast[0];
- st -= sp++;
- goto re_eval;
+ arg->arg_type = optype = O_FLOP;
+ if (arg->arg_flags & AF_COMMON) {
+ str_numset(str,0.0);
+ anum = 2;
+ argflags = arg[2].arg_flags;
+ argtype = arg[2].arg_type & A_MASK;
+ argptr = arg[2].arg_ptr;
+ sp = arglast[0];
+ st -= sp++;
+ goto re_eval;
+ }
+ else {
+ str_numset(str,1.0);
+ break;
+ }
}
str_set(str,"");
break;
@@ -2862,8 +2893,18 @@ donumset:
stab = stabent(str_get(st[1]),TRUE);
if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
goto say_undef;
-#ifdef MSDOS
+#ifdef DOSISH
+#ifdef atarist
+ if(fflush(fp))
+ str_set(str, No);
+ else
+ {
+ fp->_flag |= _IOBIN;
+ str_set(str, Yes);
+ }
+#else
str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
+#endif
#else
str_set(str, Yes);
#endif
@@ -2938,7 +2979,7 @@ donumset:
case O_SYSCALL:
value = (double)do_syscall(arglast);
goto donumset;
- case O_PIPE:
+ case O_PIPE_OP:
#ifdef HAS_PIPE
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
diff --git a/lib/find.pl b/lib/find.pl
index b853d12..8dab054 100644
--- a/lib/find.pl
+++ b/lib/find.pl
@@ -48,6 +48,7 @@ sub find {
unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
($dir,$_) = ('.', $topdir);
}
+ $name = $topdir;
chdir $dir && &wanted;
}
chdir $cwd;
@@ -61,7 +62,7 @@ sub finddir {
# Get the list of files in the current directory.
- opendir(DIR,'.') || warn "Can't open $dir: $!\n";
+ opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
local(@filenames) = readdir(DIR);
closedir(DIR);
diff --git a/lib/getopts.pl b/lib/getopts.pl
index 6590918..a0818d1 100644
--- a/lib/getopts.pl
+++ b/lib/getopts.pl
@@ -18,6 +18,7 @@ sub Getopts {
if($args[$pos+1] eq ':') {
shift(@ARGV);
if($rest eq '') {
+ ++$errs unless @ARGV;
$rest = shift(@ARGV);
}
eval "\$opt_$first = \$rest;";
diff --git a/patchlevel.h b/patchlevel.h
index f198d8a..10c8c21 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1 +1 @@
-#define PATCHLEVEL 24
+#define PATCHLEVEL 25
diff --git a/x2p/find2perl.SH b/x2p/find2perl.SH
index 032db6b..7e49cd0 100644
--- a/x2p/find2perl.SH
+++ b/x2p/find2perl.SH
@@ -6,7 +6,7 @@ case $CONFIG in
ln ../../../config.sh . || \
(echo "Can't find config.sh."; exit 1)
fi
- . config.sh
+ . ./config.sh
;;
esac
: This forces SH files to create target in same directory as SH file.
@@ -19,9 +19,13 @@ echo "Extracting find2perl (with variable substitutions)"
: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
: Protect any dollar signs and backticks that you do not want interpreted
: by putting a backslash in front. You may delete these comments.
+rm -f find2perl
$spitshell >find2perl <<!GROK!THIS!
#!$bin/perl
+eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
+ if \$running_under_some_shell;
+
\$bin = "$bin";
!GROK!THIS!
@@ -232,6 +236,9 @@ while (@ARGV) {
print <<"END";
#!$bin/perl
+eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
+ if \$running_under_some_shell;
+
END
if ($initls) {
@@ -544,7 +551,7 @@ sub tab {
$tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
if (!$statdone) {
- if ($_ =~ /^(name|print)/) {
+ if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
$delayedstat++;
}
else {