From: Larry Wall 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 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 #endif +#ifdef MSDOS +/* I_FCNTL *MUST* not be defined for MS-DOS and OS/2 + but fcntl.h is required for O_BINARY */ +#include +#endif #ifdef I_SYS_FILE #include #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 <