perl 5.0 alpha 2

[perl5.git] / parse_format

void
XXX(fcmd)
register FF *fcmd;
{
    register int i;
    register OP *arg;
    register int items;
    SV *sv;
    OP *parse_list();
    line_t oldline = curcmd->cop_line;

    sv = fcmd->ff_unparsed;
    curcmd->cop_line = fcmd->ff_line;
    fcmd->ff_unparsed = Nullsv;

    /* Grrf.  We have to fake curcmd to be in run_format's package temporarily... */
    (void)save_hptr(&curcmd->cop_stash);
    (void)save_hptr(&curstash);
    curstash = sv->sv_u.sv_hv;
    curcmd->cop_stash = sv->sv_u.sv_hv;
    arg = parse_list(sv);

    items = arg->arg_len - 1;	/* ignore $$ on end */
    for (i = 1; i <= items; i++) {
	if (!fcmd || fcmd->ff_type == FFt_NULL)
	    fatal("Too many field values");
	dehoistXXX(arg,i);
	fcmd->ff_expr = redOP(OP_ITEM,1,
	  arg[i].arg_ptr.arg_arg,Nullop,Nullop);
	if (fcmd->ff_flags & FFf_CHOP) {
	    if ((fcmd->ff_expr[1].arg_type & A_MASK) == A_STAB) {
		fcmd->ff_expr[1].arg_type = DD_LVAL;
		ldehoistXXX(fcmd->ff_expr,1);
	    }
	    else if ((fcmd->ff_expr[1].arg_type & A_MASK) == A_EXPR)
		fcmd->ff_expr[1].arg_type = A_LEXPR;
	    else
		fatal("^ field requires scalar lvalue");
	}
	fcmd = fcmd->ff_next;
    }
    if (fcmd && fcmd->ff_type)
	fatal("Not enough field values");
    curcmd->cop_line = oldline;
    Safefree(arg);
    sv_free(sv);
}