-/* $Header: cons.c,v 3.0.1.4 90/02/28 16:44:00 lwall Locked $
+/* $RCSfile: cons.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 16:15:13 $
*
- * Copyright (c) 1989, Larry Wall
+ * Copyright (c) 1991, Larry Wall
*
- * 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.
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
*
* $Log: cons.c,v $
- * Revision 3.0.1.4 90/02/28 16:44:00 lwall
- * patch9: subs which return by both mechanisms can clobber local return data
- * patch9: changed internal SUB label to _SUB_
- * patch9: line numbers were bogus during certain portions of foreach evaluation
+ * 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()
*
- * Revision 3.0.1.3 89/12/21 19:20:25 lwall
- * patch7: made nested or recursive foreach work right
+ * Revision 4.0.1.1 91/06/07 10:31:15 lwall
+ * patch4: new copyright notice
+ * patch4: added global modifier for pattern matches
*
- * Revision 3.0.1.2 89/11/17 15:08:53 lwall
- * patch5: nested foreach on same array didn't work
- *
- * Revision 3.0.1.1 89/10/26 23:09:01 lwall
- * patch1: numeric switch optimization was broken
- * patch1: unless was broken when run under the debugger
- *
- * Revision 3.0 89/10/18 15:10:23 lwall
- * 3.0 baseline
+ * Revision 4.0 91/03/20 01:05:51 lwall
+ * 4.0 baseline.
*
*/
Newz(101,sub,1,SUBR);
if (stab_sub(stab)) {
if (dowarn) {
- line_t oldline = line;
+ CMD *oldcurcmd = curcmd;
if (cmd)
- line = cmd->c_line;
+ curcmd = cmd;
warn("Subroutine %s redefined",name);
- line = oldline;
+ curcmd = oldcurcmd;
+ }
+ if (stab_sub(stab)->cmd) {
+ cmd_free(stab_sub(stab)->cmd);
+ stab_sub(stab)->cmd = Nullcmd;
+ afree(stab_sub(stab)->tosave);
}
- cmd_free(stab_sub(stab)->cmd);
- afree(stab_sub(stab)->tosave);
Safefree(stab_sub(stab));
}
- sub->filename = filename;
+ stab_sub(stab) = sub;
+ sub->filestab = curcmd->c_filestab;
saw_return = FALSE;
tosave = anew(Nullstab);
tosave->ary_fill = 0; /* make 1 based */
mycompblock.comp_alt = Nullcmd;
cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,Nullarg,mycompblock));
saw_return = FALSE;
- if (perldb)
- cmd->c_next->c_flags |= CF_TERM;
- else
- cmd->c_flags |= CF_TERM;
+ cmd->c_flags |= CF_TERM;
}
sub->cmd = cmd;
- stab_sub(stab) = sub;
if (perldb) {
- STR *str = str_nmake((double)subline);
+ STR *str;
+ STR *tmpstr = str_mortal(&str_undef);
+ sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr, subline);
+ str = str_make(buf,0);
str_cat(str,"-");
- sprintf(buf,"%ld",(long)line);
+ sprintf(buf,"%ld",(long)curcmd->c_line);
str_cat(str,buf);
name = str_get(subname);
- hstore(stab_xhash(DBsub),name,strlen(name),str,0);
- str_set(subname,"main");
+ stab_fullname(tmpstr,stab);
+ hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
+ }
+ return sub;
+}
+
+SUBR *
+make_usub(name, ix, subaddr, filename)
+char *name;
+int ix;
+int (*subaddr)();
+char *filename;
+{
+ register SUBR *sub;
+ STAB *stab = stabent(name,allstabs);
+
+ if (!stab) /* unused function */
+ return Null(SUBR*);
+ Newz(101,sub,1,SUBR);
+ if (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);
+ }
+ Safefree(stab_sub(stab));
}
- subline = 0;
+ stab_sub(stab) = sub;
+ sub->filestab = fstab(filename);
+ sub->usersub = subaddr;
+ sub->userindex = ix;
return sub;
}
+make_form(stab,fcmd)
+STAB *stab;
+FCMD *fcmd;
+{
+ if (stab_form(stab)) {
+ FCMD *tmpfcmd;
+ FCMD *nextfcmd;
+
+ for (tmpfcmd = stab_form(stab); tmpfcmd; tmpfcmd = nextfcmd) {
+ nextfcmd = tmpfcmd->f_next;
+ if (tmpfcmd->f_expr)
+ arg_free(tmpfcmd->f_expr);
+ if (tmpfcmd->f_unparsed)
+ str_free(tmpfcmd->f_unparsed);
+ if (tmpfcmd->f_pre)
+ Safefree(tmpfcmd->f_pre);
+ Safefree(tmpfcmd);
+ }
+ }
+ stab_form(stab) = fcmd;
+}
+
CMD *
block_head(tail)
register CMD *tail;
{
register CMD *cmd;
register CMD *head = cur->c_head;
- register ARG *arg;
STR *str;
if (!head)
head = cur;
if (!head->c_line)
return cur;
- str = afetch(lineary,(int)head->c_line,FALSE);
- if (!str || str->str_nok)
+ str = afetch(stab_xarray(curcmd->c_filestab),(int)head->c_line,FALSE);
+ if (str == &str_undef || str->str_nok)
return cur;
str->str_u.str_nval = (double)head->c_line;
str->str_nok = 1;
Newz(106,cmd,1,CMD);
+ str_magic(str, curcmd->c_filestab, 0, Nullch, 0);
+ str->str_magic->str_u.str_cmd = cmd;
cmd->c_type = C_EXPR;
cmd->ucmd.acmd.ac_stab = Nullstab;
cmd->ucmd.acmd.ac_expr = Nullarg;
- arg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
- arg[1].arg_type = A_SINGLE;
- arg[1].arg_ptr.arg_str = str_nmake((double)head->c_line);
cmd->c_expr = make_op(O_SUBR, 2,
stab2arg(A_WORD,DBstab),
- make_list(arg),
+ Nullarg,
Nullarg);
- cmd->c_flags |= CF_COND|CF_DBSUB;
+ cmd->c_flags |= CF_COND|CF_DBSUB|CFT_D0;
cmd->c_line = head->c_line;
cmd->c_label = head->c_label;
- cmd->c_file = filename;
+ cmd->c_filestab = curcmd->c_filestab;
+ cmd->c_stash = curstash;
return append_line(cmd, cur);
}
if (cond)
cmd->c_flags |= CF_COND;
if (cmdline == NOLINE)
- cmd->c_line = line;
+ cmd->c_line = curcmd->c_line;
else {
cmd->c_line = cmdline;
cmdline = NOLINE;
}
- cmd->c_file = filename;
+ cmd->c_filestab = curcmd->c_filestab;
+ cmd->c_stash = curstash;
if (perldb)
cmd = dodb(cmd);
return cmd;
if (arg)
cmd->c_flags |= CF_COND;
if (cmdline == NOLINE)
- cmd->c_line = line;
+ cmd->c_line = curcmd->c_line;
else {
cmd->c_line = cmdline;
cmdline = NOLINE;
}
+ cmd->c_filestab = curcmd->c_filestab;
+ cmd->c_stash = curstash;
if (perldb)
cmd = dodb(cmd);
return cmd;
if (arg)
cmd->c_flags |= CF_COND;
if (cmdline == NOLINE)
- cmd->c_line = line;
+ cmd->c_line = curcmd->c_line;
else {
cmd->c_line = cmdline;
cmdline = NOLINE;
}
+ cmd->c_filestab = curcmd->c_filestab;
+ cmd->c_stash = curstash;
cur = cmd;
alt = cblock.comp_alt;
while (alt && alt->c_type == C_ELSIF) {
if (arg[flp].arg_flags & (AF_PRE|AF_POST)) {
cmd->c_flags |= opt;
+ if (acmd && !cmd->ucmd.acmd.ac_expr && !(cmd->c_flags & CF_TERM)
+ && cmd->c_expr->arg_type == O_ITEM) {
+ arg[flp].arg_flags &= ~AF_POST; /* prefer ++$foo to $foo++ */
+ arg[flp].arg_flags |= AF_PRE; /* if value not wanted */
+ }
return; /* side effect, can't optimize */
}
else if ((arg[flp].arg_type & A_MASK) == A_STAB ||
(arg[flp].arg_type & A_MASK) == A_LVAL) {
cmd->c_stab = arg[flp].arg_ptr.arg_stab;
+ if (!context)
+ arg[flp].arg_ptr.arg_stab = Nullstab;
opt = CFT_REG;
literal:
if (!context) { /* no && or ||? */
- free_arg(arg);
+ arg_free(arg);
cmd->c_expr = Nullarg;
}
if (!(context & 1))
arg->arg_type == O_NMATCH || arg->arg_type == O_NSUBST) {
if ((arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) &&
(arg[2].arg_type & A_MASK) == A_SPAT &&
- arg[2].arg_ptr.arg_spat->spat_short ) {
+ arg[2].arg_ptr.arg_spat->spat_short &&
+ (arg->arg_type == O_SUBST || arg->arg_type == O_NSUBST ||
+ (arg[2].arg_ptr.arg_spat->spat_flags & SPAT_GLOBAL) == 0 )) {
cmd->c_stab = arg[1].arg_ptr.arg_stab;
cmd->c_short = str_smake(arg[2].arg_ptr.arg_spat->spat_short);
cmd->c_slen = arg[2].arg_ptr.arg_spat->spat_slen;
spat_free(arg[2].arg_ptr.arg_spat);
arg[2].arg_ptr.arg_spat = Nullspat; /* don't do twice */
}
+ else
+ cmd->c_spat = arg[2].arg_ptr.arg_spat;
cmd->c_flags |= sure;
}
}
arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
if (arg[2].arg_type == A_SINGLE) {
+ /*SUPPRESS 594*/
+ char *junk = str_get(arg[2].arg_ptr.arg_str);
+
cmd->c_stab = arg[1].arg_ptr.arg_stab;
cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
cmd->c_slen = cmd->c_short->str_cur+1;
cmd->c_stab = arg2[1].arg_ptr.arg_stab;
if (!(stab_io(arg2[1].arg_ptr.arg_stab)->flags & IOF_ARGV)) {
free_arg(arg2);
+ arg[2].arg_ptr.arg_arg = Nullarg;
free_arg(arg);
cmd->c_expr = Nullarg;
}
arg = cmd->ucmd.acmd.ac_expr;
if (arg && arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
cmd->c_flags &= ~CF_COND; /* "do {} while" happens at least once */
- if (arg && arg->arg_type == O_SUBR)
+ if (arg && (arg->arg_flags & AF_DEPR) &&
+ (arg->arg_type == O_SUBR || arg->arg_type == O_DBSUBR) )
cmd->c_flags &= ~CF_COND; /* likewise for "do subr() while" */
}
return cmd;
if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
- while (isspace(*oldoldbufptr))
+ while (isSPACE(*oldoldbufptr))
oldoldbufptr++;
strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
tmp2buf[bufptr - oldoldbufptr] = '\0';
}
else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
oldbufptr != bufptr) {
- while (isspace(*oldbufptr))
+ while (isSPACE(*oldbufptr))
oldbufptr++;
strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
tmp2buf[bufptr - oldbufptr] = '\0';
else
(void)sprintf(tname,"next char %c",yychar);
(void)sprintf(buf, "%s in file %s at line %d, %s\n",
- s,filename,line,tname);
- if (line == multi_end && multi_start < multi_end)
+ s,stab_val(curcmd->c_filestab)->str_ptr,curcmd->c_line,tname);
+ if (curcmd->c_line == multi_end && multi_start < multi_end)
sprintf(buf+strlen(buf),
" (Might be a runaway multi-line %c%c string starting on line %d)\n",
multi_open,multi_close,multi_start);
else
fputs(buf,stderr);
if (++error_count >= 10)
- fatal("Too many errors\n");
+ fatal("%s has too many errors.\n",
+ stab_val(curcmd->c_filestab)->str_ptr);
}
void
tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
{
arg_free(tail->ucmd.acmd.ac_expr);
+ tail->ucmd.acmd.ac_expr = Nullarg;
tail->c_type = C_NEXT;
if (cmd->ucmd.ccmd.cc_alt != Nullcmd)
tail->ucmd.ccmd.cc_alt = cmd->ucmd.ccmd.cc_alt;
tail->ucmd.acmd.ac_expr[1].arg_ptr.arg_str->str_ptr) )))
{
arg_free(tail->ucmd.acmd.ac_expr);
+ tail->ucmd.acmd.ac_expr = Nullarg;
tail->c_type = C_NEXT;
tail->ucmd.ccmd.cc_alt = newtail;
tail->ucmd.ccmd.cc_true = Nullcmd;
break;
tail = tail->c_next;
}
+ /*SUPPRESS 530*/
for ( ; tail->c_next; tail = tail->c_next) ;
}
cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
cmd->c_flags |= CFT_ARRAY; /* and set it to do the iteration */
cmd->c_stab = eachstab;
- cmd->c_short = str_new(0); /* just to save a field in struct cmd */
+ cmd->c_short = Str_new(23,0); /* just to save a field in struct cmd */
cmd->c_short->str_u.str_useful = -1;
return cmd;
while (cmd) {
if (cmd->c_type != C_WHILE) { /* WHILE block is duplicated */
- if (cmd->c_label)
+ if (cmd->c_label) {
Safefree(cmd->c_label);
- if (cmd->c_short)
+ cmd->c_label = Nullch;
+ }
+ if (cmd->c_short) {
str_free(cmd->c_short);
- if (cmd->c_spat)
- spat_free(cmd->c_spat);
- if (cmd->c_expr)
+ cmd->c_short = Nullstr;
+ }
+ if (cmd->c_expr) {
arg_free(cmd->c_expr);
+ cmd->c_expr = Nullarg;
+ }
}
switch (cmd->c_type) {
case C_WHILE:
case C_BLOCK:
case C_ELSE:
case C_IF:
- if (cmd->ucmd.ccmd.cc_true)
+ if (cmd->ucmd.ccmd.cc_true) {
cmd_free(cmd->ucmd.ccmd.cc_true);
+ cmd->ucmd.ccmd.cc_true = Nullcmd;
+ }
break;
case C_EXPR:
- if (cmd->ucmd.acmd.ac_expr)
+ if (cmd->ucmd.acmd.ac_expr) {
arg_free(cmd->ucmd.acmd.ac_expr);
+ cmd->ucmd.acmd.ac_expr = Nullarg;
+ }
break;
}
tofree = cmd;
cmd = cmd->c_next;
- Safefree(tofree);
+ if (tofree != head) /* to get Saber to shut up */
+ Safefree(tofree);
if (cmd && cmd == head) /* reached end of while loop */
break;
}
+ Safefree(head);
}
arg_free(arg)
for (i = 1; i <= arg->arg_len; i++) {
switch (arg[i].arg_type & A_MASK) {
case A_NULL:
+ if (arg->arg_type == O_TRANS) {
+ Safefree(arg[i].arg_ptr.arg_cval);
+ arg[i].arg_ptr.arg_cval = Nullch;
+ }
break;
case A_LEXPR:
if (arg->arg_type == O_AASSIGN &&
/* FALL THROUGH */
case A_EXPR:
arg_free(arg[i].arg_ptr.arg_arg);
+ arg[i].arg_ptr.arg_arg = Nullarg;
break;
case A_CMD:
cmd_free(arg[i].arg_ptr.arg_cmd);
+ arg[i].arg_ptr.arg_cmd = Nullcmd;
break;
case A_WORD:
case A_STAB:
case A_DOUBLE:
case A_BACKTICK:
str_free(arg[i].arg_ptr.arg_str);
+ arg[i].arg_ptr.arg_str = Nullstr;
break;
case A_SPAT:
spat_free(arg[i].arg_ptr.arg_spat);
+ arg[i].arg_ptr.arg_spat = Nullspat;
break;
}
}
register SPAT *sp;
HENT *entry;
- if (spat->spat_runtime)
+ if (spat->spat_runtime) {
arg_free(spat->spat_runtime);
+ spat->spat_runtime = Nullarg;
+ }
if (spat->spat_repl) {
arg_free(spat->spat_repl);
+ spat->spat_repl = Nullarg;
}
if (spat->spat_short) {
str_free(spat->spat_short);
+ spat->spat_short = Nullstr;
}
if (spat->spat_regexp) {
regfree(spat->spat_regexp);
+ spat->spat_regexp = Null(REGEXP*);
}
/* now unlink from spat list */
for (sp = stash->tbl_spatroot;
sp && sp->spat_next != spat;
sp = sp->spat_next)
+ /*SUPPRESS 530*/
;
if (sp)
sp->spat_next = spat->spat_next;
register CMD *lastcmd = Nullcmd;
while (cmd) {
- if (cmd->c_spat)
- shouldsave |= spat_tosave(cmd->c_spat);
if (cmd->c_expr)
shouldsave |= arg_tosave(cmd->c_expr,willsave);
switch (cmd->c_type) {
if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) {
if (lastcmd &&
lastcmd->c_type == C_EXPR &&
- lastcmd->ucmd.acmd.ac_expr) {
- ARG *arg = lastcmd->ucmd.acmd.ac_expr;
+ lastcmd->c_expr) {
+ ARG *arg = lastcmd->c_expr;
if (arg->arg_type == O_ASSIGN &&
arg[1].arg_type == A_LEXPR &&
stab_name(
arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab),
5)) { /* array generated for foreach */
- (void)localize(arg[1].arg_ptr.arg_arg);
+ (void)localize(arg);
}
}
projects / p5sagit/p5-mst-13.2.git / blobdiff