void cg_lab (mlabel *l, int4 base)
{
mstr glob_name;
lab_tabent lent;
if (l->ml && l->gbl)
{
lent.lab_name.len = l->mvname.len;
lent.lab_name.addr = (char *)(l->mvname.addr - (char *)stringpool.base);
lent.LABENT_LNR_OFFSET = (SIZEOF(lnr_tabent) * l->ml->line_number) + base;
lent.has_parms = (NO_FORMALLIST != l->formalcnt); /* Flag to indicate a formallist */
emit_immed((char *)&lent, SIZEOF(lent));
mlabel2xtern(&glob_name, &int_module_name, &l->mvname);
define_symbol(GTM_CODE, &glob_name, lent.LABENT_LNR_OFFSET);
}
}
triple *entryref(opctype op1, opctype op2, mint commargcode, boolean_t can_commarg, boolean_t labref, boolean_t textname)
{
oprtype offset, label, routine, rte1;
char rtn_text[SIZEOF(mident_fixed)], lab_text[SIZEOF(mident_fixed)];
mident rtnname, labname;
mstr rtn_str, lbl_str;
triple *ref, *next, *rettrip;
boolean_t same_rout;
rtnname.len = labname.len = 0;
rtnname.addr = &rtn_text[0];
labname.addr = &lab_text[0];
/* These cases don't currently exist but if they start to exist, the code in this
* routine needs to be revisited for proper operation as the textname conditions
* were assumed not to happen if can_commarg was FALSE (which it is in the one
* known use of textname TRUE - in m_zgoto).
*/
assert(!(can_commarg && textname));
switch (window_token)
{
case TK_INTLIT:
int_label();
/* caution: fall through */
case TK_IDENT:
memcpy(labname.addr, window_ident.addr, window_ident.len);
labname.len = window_ident.len;
advancewindow();
if ((TK_PLUS != window_token) && (TK_CIRCUMFLEX != window_token) && !IS_MCODE_RUNNING && can_commarg)
{
rettrip = newtriple(op1);
rettrip->operand[0] = put_mlab(&labname);
return rettrip;
}
label.oprclass = 0;
break;
case TK_ATSIGN:
if(!indirection(&label))
return NULL;
if ((TK_PLUS != window_token) && (TK_CIRCUMFLEX != window_token) && (TK_COLON != window_token)
&& can_commarg)
{
rettrip = ref = maketriple(OC_COMMARG);
ref->operand[0] = label;
ref->operand[1] = put_ilit(commargcode);
ins_triple(ref);
return rettrip;
}
labname.len = 0;
break;
case TK_PLUS:
stx_error(ERR_LABELEXPECTED);
return NULL;
default:
labname.len = 0;
label.oprclass = 0;
break;
}
if (!labref && (TK_PLUS == window_token))
{ /* Have line offset specified */
advancewindow();
if (!intexpr(&offset))
return NULL;
} else
offset.oprclass = 0;
if (TK_CIRCUMFLEX == window_token)
{ /* Have a routine name specified */
advancewindow();
switch(window_token)
{
case TK_IDENT:
MROUT2XTERN(window_ident.addr, rtnname.addr, window_ident.len);
rtn_str.len = rtnname.len = window_ident.len;
rtn_str.addr = rtnname.addr;
advancewindow();
if (!IS_MCODE_RUNNING)
{ /* Triples for indirect code */
same_rout = (MIDENT_EQ(&rtnname, &routine_name) && can_commarg);
if (!textname)
{ /* Resolve routine and label names to addresses for most calls */
if (!label.oprclass && !offset.oprclass)
{ /* Routine only (no label or offset) */
if (same_rout)
{
rettrip = newtriple(op1);
rettrip->operand[0] = put_mlab(&labname);
} else
{
rettrip = maketriple(op2);
if (rtnname.addr[0] == '%')
rtnname.addr[0] = '_';
rettrip->operand[0] = put_cdlt(&rtn_str);
mlabel2xtern(&lbl_str, &rtnname, &labname);
rettrip->operand[1] = put_cdlt(&lbl_str);
ins_triple(rettrip);
}
return rettrip;
} else if (!same_rout)
{
rte1 = put_str(rtn_str.addr, rtn_str.len);
if (rtnname.addr[0] == '%')
rtnname.addr[0] = '_';
routine = put_cdlt(&rtn_str);
ref = newtriple(OC_RHDADDR);
ref->operand[0] = rte1;
ref->operand[1] = routine;
routine = put_tref(ref);
} else
routine = put_tref(newtriple(OC_CURRHD));
} else
{ /* Return the actual names used */
if (!label.oprclass && !offset.oprclass)
{ /* Routine only (no label or offset) */
rettrip = maketriple(op2);
rettrip->operand[0] = put_str(rtn_str.addr, rtn_str.len);
ref = newtriple(OC_PARAMETER);
ref->operand[0] = put_str(labname.addr, labname.len);
ref->operand[1] = put_ilit(0);
rettrip->operand[1] = put_tref(ref);
ins_triple(rettrip);
return rettrip;
} else
routine = put_str(rtn_str.addr, rtn_str.len);
}
} else
{ /* Triples for normal compiled code */
routine = put_str(rtn_str.addr, rtn_str.len);
if (!textname)
{ /* If not returning text name, convert text name to routine header address */
ref = newtriple(OC_RHDADDR1);
ref->operand[0] = routine;
routine = put_tref(ref);
}
}
break;
case TK_ATSIGN:
if (!indirection(&routine))
return NULL;
if (!textname)
{ /* If not returning text name, convert text name to routine header address */
ref = newtriple(OC_RHDADDR1);
ref->operand[0] = routine;
routine = put_tref(ref);
}
break;
default:
stx_error(ERR_RTNNAME);
return NULL;
}
} else
{
if (!label.oprclass && (0 == labname.len))
{
stx_error(ERR_LABELEXPECTED);
return NULL;
}
if (!textname)
routine = put_tref(newtriple(OC_CURRHD));
else
{ /* If we need a name, the mechanism to retrieve it differs between normal and indirect compilation */
if (!IS_MCODE_RUNNING)
/* For normal compile, use routine name set when started compile */
routine = put_str(routine_name.addr, routine_name.len);
else
/* For an indirect compile, obtain the currently running routine header and pull the routine
* name out of that.
*/
routine = put_str(frame_pointer->rvector->routine_name.addr,
frame_pointer->rvector->routine_name.len);
}
}
if (!offset.oprclass)
offset = put_ilit(0);
if (!label.oprclass)
label = put_str(labname.addr, labname.len);
ref = textname ? newtriple(OC_PARAMETER) : newtriple(OC_LABADDR);
ref->operand[0] = label;
next = newtriple(OC_PARAMETER);
ref->operand[1] = put_tref(next);
next->operand[0] = offset;
if (!textname)
next->operand[1] = routine; /* Not needed if giving text names */
rettrip = next = newtriple(op2);
next->operand[0] = routine;
next->operand[1] = put_tref(ref);
return rettrip;
}
