void op_indtext(mval *lab, mint offset, mval *rtn, mval *dst) { bool rval; mstr *obj, object; mval mv_off; oprtype opt; triple *ref; icode_str indir_src; error_def(ERR_INDMAXNEST); error_def(ERR_STACKOFLOW); error_def(ERR_STACKCRIT); MV_FORCE_STR(lab); indir_src.str.len = lab->str.len; indir_src.str.len += SIZEOF("+^") - 1; indir_src.str.len += MAX_NUM_SIZE; indir_src.str.len += rtn->str.len; ENSURE_STP_FREE_SPACE(indir_src.str.len); DBG_MARK_STRINGPOOL_UNEXPANDABLE; /* Now that we have ensured enough space in the stringpool, we dont expect any more * garbage collections or expansions until we are done with the below initialization. */ /* Push an mval pointing to the complete entry ref on to the stack so the string is valid even * if garbage collection occurs before cache_put() */ PUSH_MV_STENT(MVST_MVAL); mv_chain->mv_st_cont.mvs_mval.mvtype = 0; /* so stp_gcol (if invoked below) does not get confused by this otherwise * incompletely initialized mval in the M-stack */ mv_chain->mv_st_cont.mvs_mval.str.addr = (char *)stringpool.free; memcpy(stringpool.free, lab->str.addr, lab->str.len); stringpool.free += lab->str.len; *stringpool.free++ = '+'; MV_FORCE_MVAL(&mv_off, offset); MV_FORCE_STRD(&mv_off); /* goes at stringpool.free. we already made enough space in the stp_gcol() call */ *stringpool.free++ = '^'; memcpy(stringpool.free, rtn->str.addr, rtn->str.len); stringpool.free += rtn->str.len; mv_chain->mv_st_cont.mvs_mval.str.len = INTCAST(stringpool.free - (unsigned char*)mv_chain->mv_st_cont.mvs_mval.str.addr); mv_chain->mv_st_cont.mvs_mval.mvtype = MV_STR; /* initialize mvtype now that mval has been otherwise completely set up */ DBG_MARK_STRINGPOOL_EXPANDABLE; /* Now that we are done with stringpool.free initializations, mark as free for expansion */ indir_src.str = mv_chain->mv_st_cont.mvs_mval.str; indir_src.code = indir_text; if (NULL == (obj = cache_get(&indir_src))) { comp_init(&indir_src.str); rval = f_text(&opt, OC_FNTEXT); if (!comp_fini(rval, &object, OC_IRETMVAL, &opt, indir_src.str.len)) { assert(mv_chain->mv_st_type == MVST_MVAL); POP_MV_STENT(); return; } indir_src.str.addr = mv_chain->mv_st_cont.mvs_mval.str.addr; cache_put(&indir_src, &object); *ind_result_sp++ = dst; if (ind_result_sp >= ind_result_top) rts_error(VARLSTCNT(1) ERR_INDMAXNEST); assert(mv_chain->mv_st_type == MVST_MVAL); POP_MV_STENT(); /* unwind the mval entry before the new frame gets added by comp_indir below */ comp_indr(&object); return; } *ind_result_sp++ = dst; if (ind_result_sp >= ind_result_top) rts_error(VARLSTCNT(1) ERR_INDMAXNEST); assert(mv_chain->mv_st_type == MVST_MVAL); POP_MV_STENT(); /* unwind the mval entry before the new frame gets added by comp_indir below */ comp_indr(obj); return; }
int m_merge(void) { int type; boolean_t used_glvn_slot; mval mv; opctype put_oc; oprtype mopr, control_slot; triple *obp, *ref, *restart, *s1, *sub, tmpchain; DCL_THREADGBL_ACCESS; SETUP_THREADGBL_ACCESS; used_glvn_slot = FALSE; sub = NULL; restart = newtriple(OC_RESTARTPC); /* Here is where a restart should pick up */ dqinit(&tmpchain, exorder); /* Left Hand Side of EQUAL sign */ switch (TREF(window_token)) { case TK_IDENT: if (!lvn(&mopr, OC_PUTINDX, 0)) return FALSE; if (OC_PUTINDX == mopr.oprval.tref->opcode) { /* we insert left hand side argument into tmpchain. */ sub = mopr.oprval.tref; put_oc = OC_PUTINDX; dqdel(mopr.oprval.tref, exorder); dqins(tmpchain.exorder.bl, exorder, mopr.oprval.tref); } ref = maketriple(OC_MERGE_LVARG); ref->operand[0] = put_ilit(MARG1_LCL); ref->operand[1] = mopr; dqins(tmpchain.exorder.bl, exorder, ref); break; case TK_CIRCUMFLEX: s1 = (TREF(curtchain))->exorder.bl; if (!gvn()) return FALSE; assert(OC_GVRECTARG != (TREF(curtchain))->opcode); /* we count on gvn not having been shifted */ for (sub = (TREF(curtchain))->exorder.bl; sub != s1; sub = sub->exorder.bl) { put_oc = sub->opcode; if (OC_GVNAME == put_oc || OC_GVNAKED == put_oc || OC_GVEXTNAM == put_oc) break; } assert((OC_GVNAME == put_oc) || (OC_GVNAKED == put_oc) || (OC_GVEXTNAM == put_oc)); /* we insert left hand side argument into tmpchain. */ dqdel(sub, exorder); dqins(tmpchain.exorder.bl ,exorder, sub); ref = maketriple(OC_MERGE_GVARG); ref->operand[0] = put_ilit(MARG1_GBL); dqins(tmpchain.exorder.bl, exorder, ref); break; case TK_ATSIGN: if (!indirection(&mopr)) return FALSE; if (TK_EQUAL != TREF(window_token)) { ref = newtriple(OC_COMMARG); ref->operand[0] = mopr; ref->operand[1] = put_ilit((mint) indir_merge); return TRUE; } type = MARG1_LCL | MARG1_GBL; memset(&mv, 0, SIZEOF(mval)); /* Initialize so unused fields don't cause object hash differences */ MV_FORCE_MVAL(&mv, type); MV_FORCE_STRD(&mv); if (TREF(side_effect_handling)) { /* save and restore the variable lookup for true left-to-right evaluation */ used_glvn_slot = TRUE; INSERT_INDSAVGLVN(control_slot, mopr, ANY_SLOT, 0); /* 0 flag to defer global reference */ ref = maketriple(OC_INDMERGE2); ref->operand[0] = control_slot; } else { /* quick and dirty old way */ ref = maketriple(OC_INDMERGE); ref->operand[0] = put_lit(&mv); ref->operand[1] = mopr; } /* we insert left hand side argument into tmpchain. */ dqins(tmpchain.exorder.bl, exorder, ref); break; default: stx_error(ERR_VAREXPECTED); return FALSE; } if (TREF(window_token) != TK_EQUAL) { stx_error(ERR_EQUAL); return FALSE; } advancewindow(); /* Right Hand Side of EQUAL sign */ TREF(temp_subs) = FALSE; switch (TREF(window_token)) { case TK_IDENT: if (!lvn(&mopr, OC_M_SRCHINDX, 0)) return FALSE; ref = newtriple(OC_MERGE_LVARG); ref->operand[0] = put_ilit(MARG2_LCL); ref->operand[1] = mopr; break; case TK_CIRCUMFLEX: if (!gvn()) return FALSE; ref = newtriple(OC_MERGE_GVARG); ref->operand[0] = put_ilit(MARG2_GBL); break; case TK_ATSIGN: TREF(temp_subs) = TRUE; if (!indirection(&mopr)) { stx_error(ERR_VAREXPECTED); return FALSE; } type = MARG2_LCL | MARG2_GBL; memset(&mv, 0, SIZEOF(mval)); /* Initialize so unused fields don't cause object hash differences */ MV_FORCE_MVAL(&mv, type); MV_FORCE_STRD(&mv); ref = maketriple(OC_INDMERGE); ref->operand[0] = put_lit(&mv); ref->operand[1] = mopr; ins_triple(ref); break; default: stx_error(ERR_VAREXPECTED); return FALSE; } /* * Make sure that during runtime right hand side argument is processed first. * This is specially important if global naked variable is used . */ obp = (TREF(curtchain))->exorder.bl; dqadd(obp, &tmpchain, exorder); if (TREF(temp_subs) && TREF(side_effect_handling) && sub) create_temporaries(sub, put_oc); TREF(temp_subs) = FALSE; if (used_glvn_slot) { ref = newtriple(OC_GLVNPOP); ref->operand[0] = control_slot; } ref = newtriple(OC_MERGE); return TRUE; }