cons.c

早期freebsd实现

/* $RCSfile: cons.c,v $$Revision: 4.0.1.4 $$Date: 1993/02/05 19:30:15 $
 *
 *    Copyright (c) 1991, Larry Wall
 *
 *    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 4.0.1.4  1993/02/05  19:30:15  lwall
 * patch36: fixed various little coredump bugs
 *
 * 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()
 * 
 * Revision 4.0.1.1  91/06/07  10:31:15  lwall
 * patch4: new copyright notice
 * patch4: added global modifier for pattern matches
 * 
 * Revision 4.0  91/03/20  01:05:51  lwall
 * 4.0 baseline.
 * 
 */

#include "EXTERN.h"
#include "perl.h"
#include "perly.h"

extern char *tokename[];
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;

SUBR *
make_sub(name,cmd)
char *name;
CMD *cmd;
{
    register SUBR *sub;
    STAB *stab = stabent(name,TRUE);

    if (sub = stab_sub(stab)) {
	if (dowarn) {
	    CMD *oldcurcmd = curcmd;

	    if (cmd)
		curcmd = cmd;
	    warn("Subroutine %s redefined",name);
	    curcmd = oldcurcmd;
	}
	if (!sub->usersub && sub->cmd) {
	    cmd_free(sub->cmd);
	    sub->cmd = Nullcmd;
	    afree(sub->tosave);
	}
	Safefree(sub);
    }
    Newz(101,sub,1,SUBR);
    stab_sub(stab) = sub;
    sub->filestab = curcmd->c_filestab;
    saw_return = FALSE;
    tosave = anew(Nullstab);
    tosave->ary_fill = 0;	/* make 1 based */
    (void)cmd_tosave(cmd,FALSE);	/* this builds the tosave array */
    sub->tosave = tosave;
    if (saw_return) {
	struct compcmd mycompblock;

	mycompblock.comp_true = cmd;
	mycompblock.comp_alt = Nullcmd;
	cmd = add_label(savestr("_SUB_"),make_ccmd(C_BLOCK,0,
	    Nullarg,mycompblock));
	saw_return = FALSE;
	cmd->c_flags |= CF_TERM;
	cmd->c_head = cmd;
    }
    sub->cmd = cmd;
    if (perldb) {
	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)curcmd->c_line);
	str_cat(str,buf);
	stab_efullname(tmpstr,stab);
	hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
    }
    Safefree(name);
    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*);
    if (sub = stab_sub(stab)) {
	if (dowarn)
	    warn("Subroutine %s redefined",name);
	if (!sub->usersub && sub->cmd) {
	    cmd_free(sub->cmd);
	    sub->cmd = Nullcmd;
	    afree(sub->tosave);
	}
	Safefree(sub);
    }
    Newz(101,sub,1,SUBR);
    stab_sub(stab) = sub;
    sub->filestab = fstab(filename);
    sub->usersub = subaddr;
    sub->userindex = ix;
    return sub;
}

void
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;
{
    CMD *head;
    register int opt;
    register int last_opt = 0;
    register STAB *last_stab = Nullstab;
    register int count = 0;
    register CMD *switchbeg = Nullcmd;

    if (tail == Nullcmd) {
	return tail;
    }
    head = tail->c_head;

    for (tail = head; tail; tail = tail->c_next) {

	/* save one measly dereference at runtime */
	if (tail->c_type == C_IF) {
	    if (!(tail->ucmd.ccmd.cc_alt = tail->ucmd.ccmd.cc_alt->c_next))
		tail->c_flags |= CF_TERM;
	}
	else if (tail->c_type == C_EXPR) {
	    ARG *arg;

	    if (tail->ucmd.acmd.ac_expr)
		arg = tail->ucmd.acmd.ac_expr;
	    else
		arg = tail->c_expr;
	    if (arg) {
		if (arg->arg_type == O_RETURN)
		    tail->c_flags |= CF_TERM;
		else if (arg->arg_type == O_ITEM && arg[1].arg_type == A_CMD)
		    tail->c_flags |= CF_TERM;
	    }
	}
	if (!tail->c_next)
	    tail->c_flags |= CF_TERM;

	if (tail->c_expr && (tail->c_flags & CF_OPTIMIZE) == CFT_FALSE)
	    opt_arg(tail,1, tail->c_type == C_EXPR);

	/* now do a little optimization on case-ish structures */
	switch(tail->c_flags & (CF_OPTIMIZE|CF_FIRSTNEG|CF_INVERT)) {
	case CFT_ANCHOR:
	case CFT_STROP:
	    opt = (tail->c_flags & CF_NESURE) ? CFT_STROP : 0;
	    break;
	case CFT_CCLASS:
	    opt = CFT_STROP;
	    break;
	case CFT_NUMOP:
	    opt = (tail->c_slen == O_NE ? 0 : CFT_NUMOP);
	    if ((tail->c_flags&(CF_NESURE|CF_EQSURE)) != (CF_NESURE|CF_EQSURE))
		opt = 0;
	    break;
	default:
	    opt = 0;
	}
	if (opt && opt == last_opt && tail->c_stab == last_stab)
	    count++;
	else {
	    if (count >= 3) {		/* is this the breakeven point? */
		if (last_opt == CFT_NUMOP)
		    make_nswitch(switchbeg,count);
		else
		    make_cswitch(switchbeg,count);
	    }
	    if (opt) {
		count = 1;
		switchbeg = tail;
	    }
	    else
		count = 0;
	}
	last_opt = opt;
	last_stab = tail->c_stab;
    }
    if (count >= 3) {		/* is this the breakeven point? */
	if (last_opt == CFT_NUMOP)
	    make_nswitch(switchbeg,count);
	else
	    make_cswitch(switchbeg,count);
    }
    return head;
}

/* We've spotted a sequence of CMDs that all test the value of the same
 * 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;
{
    register CMD *cur;
    register CMD **loc;
    register int i;
    register int min = 255;
    register int max = 0;

    /* make a new head in the exact same spot */
    New(102,cur, 1, CMD);
    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;

    Newz(103,loc,258,CMD*);
    loc++;				/* lie a little */
    while (count--) {
	if ((cur->c_flags & CF_OPTIMIZE) == CFT_CCLASS) {
	    for (i = 0; i <= 255; i++) {
		if (!loc[i] && cur->c_short->str_ptr[i>>3] & (1 << (i&7))) {
		    loc[i] = cur;
		    if (i < min)
			min = i;
		    if (i > max)
			max = i;
		}
	    }
	}
	else {
	    i = *cur->c_short->str_ptr & 255;
	    if (!loc[i]) {
		loc[i] = cur;
		if (i < min)
		    min = i;
		if (i > max)
		    max = i;
	    }
	}
	cur = cur->c_next;
    }
    max++;
    if (min > 0)
	Move(&loc[min],&loc[0], max - min, CMD*);
    loc--;
    min--;
    max -= min;
    for (i = 0; i <= max; i++)
	if (!loc[i])
	    loc[i] = cur;
    Renew(loc,max+1,CMD*);	/* chop it down to size */
    head->ucmd.scmd.sc_offset = min;
    head->ucmd.scmd.sc_max = max;
    head->ucmd.scmd.sc_next = loc;
}

static void
make_nswitch(head,count)
register CMD *head;
int count;
{
    register CMD *cur = head;
    register CMD **loc;
    register int i;
    register int min = 32767;
    register int max = -32768;
    int origcount = count;
    double value;		/* or your money back! */
    short changed;		/* so triple your money back! */

    while (count--) {
	i = (int)str_gnum(cur->c_short);
	value = (double)i;
	if (value != cur->c_short->str_u.str_nval)
	    return;		/* fractional values--just forget it */
	changed = i;
	if (changed != i)
	    return;		/* too big for a short */
	if (cur->c_slen == O_LE)
	    i++;
	else if (cur->c_slen == O_GE)	/* we only do < or > here */
	    i--;
	if (i < min)
	    min = i;
	if (i > max)
	    max = i;
	cur = cur->c_next;
    }
    count = origcount;
    if (max - min > count * 2 + 10)		/* too sparse? */
	return;

    /* now make a new head in the exact same spot */
    New(104,cur, 1, CMD);
    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;

    Newz(105,loc, max - min + 3, CMD*);
    loc++;
    max -= min;
    max++;
    while (count--) {
	i = (int)str_gnum(cur->c_short);
	i -= min;
	switch(cur->c_slen) {
	case O_LE:
	    i++;
	case O_LT:
	    for (i--; i >= -1; i--)
		if (!loc[i])
		    loc[i] = cur;
	    break;
	case O_GE:
	    i--;
	case O_GT:
	    for (i++; i <= max; i++)
		if (!loc[i])
		    loc[i] = cur;
	    break;
	case O_EQ:
	    if (!loc[i])
		loc[i] = cur;
	    break;
	}
	cur = cur->c_next;
    }
    loc--;
    min--;
    max++;
    for (i = 0; i <= max; i++)
	if (!loc[i])
	    loc[i] = cur;
    head->ucmd.scmd.sc_offset = min;
    head->ucmd.scmd.sc_max = max;
    head->ucmd.scmd.sc_next = loc;
}

CMD *
append_line(head,tail)
register CMD *head;
register CMD *tail;
{
    if (tail == Nullcmd)
	return head;
    if (!tail->c_head)			/* make sure tail is well formed */
	tail->c_head = tail;
    if (head != Nullcmd) {
	tail = tail->c_head;		/* get to start of tail list */
	if (!head->c_head)
	    head->c_head = head;	/* start a new head list */
	while (head->c_next) {
	    head->c_next->c_head = head->c_head;
	    head = head->c_next;	/* get to end of head list */
	}
	head->c_next = tail;		/* link to end of old list */
	tail->c_head = head->c_head;	/* propagate head pointer */
    }
    while (tail->c_next) {
	tail->c_next->c_head = tail->c_head;
	tail = tail->c_next;
    }
    return tail;
}

CMD *
dodb(cur)
CMD *cur;
{
    register CMD *cmd;
    register CMD *head = cur->c_head;
    STR *str;

    if (!head)
	head = cur;
    if (!head->c_line)
	return cur;
    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;
    cmd->c_expr = make_op(O_SUBR, 2,
	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;
    cmd->c_filestab = curcmd->c_filestab;
    cmd->c_stash = curstash;
    return append_line(cmd, cur);
}

CMD *
make_acmd(type,stab,cond,arg)
int type;
STAB *stab;
ARG *cond;
ARG *arg;
{
    register CMD *cmd;

    Newz(107,cmd,1,CMD);
    cmd->c_type = type;
    cmd->ucmd.acmd.ac_stab = stab;
    cmd->ucmd.acmd.ac_expr = arg;
    cmd->c_expr = cond;
    if (cond)
	cmd->c_flags |= CF_COND;
    if (cmdline == NOLINE)
	cmd->c_line = curcmd->c_line;
    else {
	cmd->c_line = cmdline;