int exfunc (oprtype *a)
{
triple *ref0, *calltrip, *masktrip, *counttrip, *funret, *tripsize;
triple *triptr;
triple tmpchain, *oldchain, *obp, *routineref, *labelref;
error_def (ERR_ACTOFFSET);
assert (window_token == TK_DOLLAR);
advancewindow();
assert (window_token == TK_DOLLAR);
advancewindow();
dqinit (&tmpchain, exorder);
oldchain = setcurtchain (&tmpchain);
calltrip = entryref (OC_EXFUN, OC_EXTEXFUN, INDIR_DUMMY, TRUE, TRUE);
setcurtchain (oldchain);
if (!calltrip) return FALSE;
if (calltrip->opcode == OC_EXFUN)
{
assert(calltrip->operand[0].oprclass == MLAB_REF);
ref0 = newtriple(OC_PARAMETER);
ref0->operand[0] = put_tsiz(); /* Need size of following code gen triple here */
calltrip->operand[1] = put_tref(ref0);
tripsize = ref0->operand[0].oprval.tref;
assert(OC_TRIPSIZE == tripsize->opcode);
}
else
{
if (calltrip->opcode == OC_EXTEXFUN)
{
assert (calltrip->operand[1].oprclass == TRIP_REF);
if (calltrip->operand[1].oprval.tref->opcode == OC_CDLIT)
assert (calltrip->operand[1].oprval.tref->operand[0].oprclass == CDLT_REF);
else
{
assert (calltrip->operand[1].oprval.tref->opcode == OC_LABADDR);
assert (calltrip->operand[1].oprval.tref->operand[1].oprclass == TRIP_REF);
assert (calltrip->operand[1].oprval.tref->operand[1].oprval.tref->opcode == OC_PARAMETER);
assert (calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprclass == TRIP_REF);
assert (calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprval.tref->opcode
== OC_ILIT);
assert
(calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprval.tref->operand[0].oprclass
== ILIT_REF);
if
(calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprval.tref->operand[0].oprval.ilit
!= 0)
{
stx_error (ERR_ACTOFFSET);
return FALSE;
}
}
}
else /* $$ @dlabel [actuallist] */
{
assert (calltrip->opcode == OC_COMMARG);
assert (calltrip->operand[1].oprclass == TRIP_REF);
assert (calltrip->operand[1].oprval.tref->opcode == OC_ILIT);
assert (calltrip->operand[1].oprval.tref->operand[0].oprclass == ILIT_REF);
assert (calltrip->operand[1].oprval.tref->operand[0].oprval.ilit == INDIR_DUMMY);
assert (calltrip->exorder.fl == &tmpchain);
routineref = maketriple (OC_CURRHD);
labelref = maketriple (OC_LABADDR);
ref0 = maketriple (OC_PARAMETER);
dqins (calltrip->exorder.bl, exorder, routineref);
dqins (calltrip->exorder.bl, exorder, labelref);
dqins (calltrip->exorder.bl, exorder, ref0);
labelref->operand[0] = calltrip->operand[0];
labelref->operand[1] = put_tref (ref0);
ref0->operand[0] = calltrip->operand[1];
ref0->operand[0].oprval.tref->operand[0].oprval.ilit = 0;
ref0->operand[1] = put_tref (routineref);
calltrip->operand[0] = put_tref (routineref);
calltrip->operand[1] = put_tref (labelref);
calltrip->opcode = OC_EXTEXFUN;
}
ref0 = newtriple (OC_PARAMETER);
ref0->operand[0] = calltrip->operand[1];
calltrip->operand[1] = put_tref (ref0);
}
if (window_token != TK_LPAREN)
{
masktrip = newtriple (OC_PARAMETER);
counttrip = newtriple (OC_PARAMETER);
masktrip->operand[0] = put_ilit (0);
counttrip->operand[0] = put_ilit (0);
masktrip->operand[1] = put_tref (counttrip);
ref0->operand[1] = put_tref (masktrip);
}
else
if (!actuallist (&ref0->operand[1])) return FALSE;
obp = oldchain->exorder.bl;
dqadd (obp, &tmpchain, exorder); /*this is a violation of info hiding*/
if (calltrip->opcode == OC_EXFUN)
{
assert(calltrip->operand[0].oprclass == MLAB_REF);
triptr = newtriple (OC_JMP);
triptr->operand[0] = put_mfun (&calltrip->operand[0].oprval.lab->mvname);
calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */
tripsize->operand[0].oprval.tsize->ct = triptr;
}
funret = newtriple (OC_EXFUNRET);
funret->operand[0] = *a = put_tref (calltrip);
return TRUE;
}
int m_do(void)
{
int opcd;
oprtype *cr;
triple *calltrip, *labelref, *obp, *oldchain, *ref0, *ref1, *routineref, tmpchain, *triptr;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
if ((TK_EOL == TREF(window_token)) || (TK_SPACE == TREF(window_token)))
{
if (!run_time) /* DO SP SP is a noop at run time */
{
calltrip = newtriple(OC_CALLSP);
calltrip->operand[0] = put_mnxl();
}
return TRUE;
} else if (TK_AMPERSAND == TREF(window_token))
{
if (!extern_func(0))
return FALSE;
else
return TRUE;
}
dqinit(&tmpchain, exorder);
oldchain = setcurtchain(&tmpchain);
calltrip = entryref(OC_CALL, OC_EXTCALL, (mint)indir_do, TRUE, FALSE, FALSE);
setcurtchain(oldchain);
if (!calltrip)
return FALSE;
if (TK_LPAREN == TREF(window_token))
{
if (OC_CALL == calltrip->opcode)
{
assert(MLAB_REF == calltrip->operand[0].oprclass);
calltrip->opcode = OC_EXCAL;
ref0 = calltrip;
} else
{
if (OC_EXTCALL == calltrip->opcode)
{
assert(TRIP_REF == calltrip->operand[1].oprclass);
if (OC_CDLIT == calltrip->operand[1].oprval.tref->opcode)
assert(CDLT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass);
else
{
assert(OC_LABADDR == calltrip->operand[1].oprval.tref->opcode);
assert(TRIP_REF == calltrip->operand[1].oprval.tref->operand[1].oprclass);
assert(OC_PARAMETER == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->opcode);
assert(TRIP_REF ==
calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprclass);
DEBUG_ONLY(opcd = calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
operand[0].oprval.tref->opcode);
assert((OC_ILIT == opcd) || (OC_COMINT == opcd));
DEBUG_ONLY(opcd = calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
operand[0].oprval.tref->operand[0].oprclass);
assert((ILIT_REF == opcd) || (TRIP_REF == opcd));
/* The opcd references above added to allow an invalid syntax using indirect values for
* offsets while specifying a parm list to get through the above asserts (invalid syntax
* should not trip asserts) but it leads to the conclusion that the below test may not be
* robust enough since it is looking at a literal integer value when there is none so have
* added further checks mirroring the first checks done in the two most recent asserts to
* make the check more robust. [Example bad code: Do @lbl+@n^artn(arg)]
*/
if ((0 != calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
operand[0].oprval.tref->operand[0].oprval.ilit)
|| (OC_ILIT != calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
operand[0].oprval.tref->opcode)
|| (ILIT_REF != calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
operand[0].oprval.tref->operand[0].oprclass))
{
stx_error (ERR_ACTOFFSET);
return FALSE;
}
}
} else
{ /* DO _ @dlabel actuallist */
assert(OC_COMMARG == calltrip->opcode);
assert(TRIP_REF == calltrip->operand[1].oprclass);
assert(OC_ILIT == calltrip->operand[1].oprval.tref->opcode);
assert(ILIT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass);
assert((mint)indir_do == calltrip->operand[1].oprval.tref->operand[0].oprval.ilit);
assert(calltrip->exorder.fl == &tmpchain);
routineref = maketriple(OC_CURRHD);
labelref = maketriple(OC_LABADDR);
ref0 = maketriple(OC_PARAMETER);
dqins(calltrip->exorder.bl, exorder, routineref);
dqins(calltrip->exorder.bl, exorder, labelref);
dqins(calltrip->exorder.bl, exorder, ref0);
labelref->operand[0] = calltrip->operand[0];
labelref->operand[1] = put_tref (ref0);
ref0->operand[0] = calltrip->operand[1];
ref0->operand[0].oprval.tref->operand[0].oprval.ilit = 0;
ref0->operand[1] = put_tref (routineref);
calltrip->operand[0] = put_tref(routineref);
calltrip->operand[1] = put_tref(labelref);
}
calltrip->opcode = OC_EXTEXCAL;
ref0 = newtriple(OC_PARAMETER);
ref0->operand[0] = calltrip->operand[1];
calltrip->operand[1] = put_tref(ref0);
}
if (!actuallist(&ref0->operand[1]))
return FALSE;
} else if (OC_CALL == calltrip->opcode)
{
if (TREF(for_stack_ptr) != (oprtype **)TADR(for_stack))
{
if (TAREF1(for_temps, (TREF(for_stack_ptr) - (oprtype **)TADR(for_stack))))
calltrip->opcode = OC_FORLCLDO;
}
}
if (TK_COLON == TREF(window_token))
{
advancewindow();
cr = (oprtype *)mcalloc(SIZEOF(oprtype));
if (!bool_expr(FALSE, cr))
return FALSE;
if ((TREF(expr_start) != TREF(expr_start_orig)) && (OC_NOOP != (TREF(expr_start))->opcode))
{
triptr = newtriple(OC_GVRECTARG);
triptr->operand[0] = put_tref(TREF(expr_start));
}
obp = oldchain->exorder.bl;
dqadd(obp, &tmpchain, exorder); /*this is a violation of info hiding*/
if (calltrip->opcode == OC_EXCAL)
{
triptr = newtriple(OC_JMP);
triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */
}
if ((TREF(expr_start) != TREF(expr_start_orig)) && (OC_NOOP != (TREF(expr_start))->opcode))
{
ref0 = newtriple(OC_JMP);
ref1 = newtriple(OC_GVRECTARG);
ref1->operand[0] = put_tref(TREF(expr_start));
*cr = put_tjmp(ref1);
tnxtarg(&ref0->operand[0]);
} else
tnxtarg(cr);
} else
{
obp = oldchain->exorder.bl;
dqadd(obp, &tmpchain, exorder); /*this is a violation of info hiding*/
if (OC_EXCAL == calltrip->opcode)
{
triptr = newtriple(OC_JMP);
triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */
}
}
return TRUE;
}
int exfunc(oprtype *a, boolean_t alias_target)
{
triple *calltrip, *calltrip_opr1_tref, *counttrip, *funret, *labelref, *masktrip;
triple *oldchain, *ref0, *routineref, tmpchain, *triptr;
# if defined(USHBIN_SUPPORTED) || defined(VMS)
triple *tripsize;
# endif
assert(TK_DOLLAR == window_token);
advancewindow();
dqinit(&tmpchain, exorder);
oldchain = setcurtchain(&tmpchain);
calltrip = entryref(OC_EXFUN, OC_EXTEXFUN, INDIR_DUMMY, TRUE, TRUE, FALSE);
setcurtchain(oldchain);
if (!calltrip)
return FALSE;
if (OC_EXFUN == calltrip->opcode)
{
assert(MLAB_REF == calltrip->operand[0].oprclass);
# if defined(USHBIN_SUPPORTED) || defined(VMS)
ref0 = newtriple(OC_PARAMETER);
ref0->operand[0] = put_tsiz(); /* Need size of following code gen triple here */
calltrip->operand[1] = put_tref(ref0);
tripsize = ref0->operand[0].oprval.tref;
assert(OC_TRIPSIZE == tripsize->opcode);
# else
ref0 = calltrip;
# endif
} else
{
calltrip_opr1_tref = calltrip->operand[1].oprval.tref;
if (OC_EXTEXFUN == calltrip->opcode)
{
assert(TRIP_REF == calltrip->operand[1].oprclass);
if (OC_CDLIT == calltrip_opr1_tref->opcode)
assert(CDLT_REF == calltrip_opr1_tref->operand[0].oprclass);
else
{
assert(OC_LABADDR == calltrip_opr1_tref->opcode);
assert(TRIP_REF == calltrip_opr1_tref->operand[1].oprclass);
assert(OC_PARAMETER == calltrip_opr1_tref->operand[1].oprval.tref->opcode);
assert(TRIP_REF == calltrip_opr1_tref->operand[1].oprval.tref->operand[0].oprclass);
assert(OC_ILIT == calltrip_opr1_tref->operand[1].oprval.tref->operand[0].oprval.tref->opcode);
assert(ILIT_REF
== calltrip_opr1_tref->operand[1].oprval.tref->operand[0].oprval.tref->operand[0].oprclass);
if (0 != calltrip_opr1_tref->operand[1].oprval.tref->operand[0].oprval.tref->operand[0].oprval.ilit)
{
stx_error(ERR_ACTOFFSET);
return FALSE;
}
}
} else /* $$ @dlabel [actuallist] */
{
assert(OC_COMMARG == calltrip->opcode);
assert(TRIP_REF == calltrip->operand[1].oprclass);
assert(OC_ILIT == calltrip_opr1_tref->opcode);
assert(ILIT_REF == calltrip_opr1_tref->operand[0].oprclass);
assert(INDIR_DUMMY == calltrip_opr1_tref->operand[0].oprval.ilit);
assert(calltrip->exorder.fl == &tmpchain);
routineref = maketriple(OC_CURRHD);
labelref = maketriple(OC_LABADDR);
ref0 = maketriple(OC_PARAMETER);
dqins(calltrip->exorder.bl, exorder, routineref);
dqins(calltrip->exorder.bl, exorder, labelref);
dqins(calltrip->exorder.bl, exorder, ref0);
labelref->operand[0] = calltrip->operand[0];
labelref->operand[1] = put_tref(ref0);
ref0->operand[0] = calltrip->operand[1];
ref0->operand[0].oprval.tref->operand[0].oprval.ilit = 0;
ref0->operand[1] = put_tref(routineref);
calltrip->operand[0] = put_tref(routineref);
calltrip->operand[1] = put_tref(labelref);
calltrip->opcode = OC_EXTEXFUN;
}
ref0 = newtriple(OC_PARAMETER);
ref0->operand[0] = calltrip->operand[1];
calltrip->operand[1] = put_tref(ref0);
}
if (TK_LPAREN != window_token)
{
masktrip = newtriple(OC_PARAMETER);
counttrip = newtriple(OC_PARAMETER);
masktrip->operand[0] = put_ilit(0);
counttrip->operand[0] = put_ilit(0);
masktrip->operand[1] = put_tref(counttrip);
ref0->operand[1] = put_tref(masktrip);
} else
if (!actuallist(&ref0->operand[1]))
return FALSE;
triptr = oldchain->exorder.bl;
dqadd(triptr, &tmpchain, exorder); /*this is a violation of info hiding*/
if (OC_EXFUN == calltrip->opcode)
{
assert(MLAB_REF == calltrip->operand[0].oprclass);
triptr = newtriple(OC_JMP);
triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */
# if defined(USHBIN_SUPPORTED) || defined(VMS)
tripsize->operand[0].oprval.tsize->ct = triptr;
# endif
}
/* If target is an alias, use special container-expecting routine OC_EXFUNRETALS, else regular OC_EXFUNRET */
funret = newtriple((alias_target ? OC_EXFUNRETALS : OC_EXFUNRET));
funret->operand[0] = *a = put_tref(calltrip);
return TRUE;
}
int m_do(void)
{
triple tmpchain, *oldchain, *obp, *ref0, *tripsize,
*triptr, *ref1, *calltrip, *routineref, *labelref;
oprtype *cr;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
if ((TK_SPACE == window_token) || (TK_EOL == window_token))
{
if (!run_time) /* DO SP SP is a noop at run time */
{
calltrip = newtriple(OC_CALLSP);
calltrip->operand[0] = put_mnxl();
calltrip->operand[1] = put_ocnt();
}
return TRUE;
} else if (TK_AMPERSAND == window_token)
{
if (!extern_func(0))
return FALSE;
else
return TRUE;
}
dqinit(&tmpchain, exorder);
oldchain = setcurtchain(&tmpchain);
calltrip = entryref(OC_CALL, OC_EXTCALL, (mint)indir_do, TRUE, FALSE, FALSE);
setcurtchain(oldchain);
if (!calltrip)
return FALSE;
if (TK_LPAREN == window_token)
{
if (OC_CALL == calltrip->opcode)
{
assert(MLAB_REF == calltrip->operand[0].oprclass);
calltrip->opcode = OC_EXCAL;
ref0 = newtriple(OC_PARAMETER);
calltrip->operand[1] = put_tref(ref0);
ref0->operand[0] = put_tsiz(); /* parm to hold size of jump codegen */
tripsize = ref0->operand[0].oprval.tref;
assert(OC_TRIPSIZE == tripsize->opcode);
} else
{
if (OC_EXTCALL == calltrip->opcode)
{
assert(TRIP_REF == calltrip->operand[1].oprclass);
if (OC_CDLIT == calltrip->operand[1].oprval.tref->opcode)
assert(CDLT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass);
else
{
assert(OC_LABADDR == calltrip->operand[1].oprval.tref->opcode);
assert(TRIP_REF == calltrip->operand[1].oprval.tref->operand[1].oprclass);
assert(OC_PARAMETER == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->opcode);
assert(TRIP_REF ==
calltrip->operand[1].oprval.tref->operand[1].oprval.tref->operand[0].oprclass);
assert(OC_ILIT == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
operand[0].oprval.tref->opcode);
assert(ILIT_REF == calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
operand[0].oprval.tref->operand[0].oprclass);
if (0 != calltrip->operand[1].oprval.tref->operand[1].oprval.tref->
operand[0].oprval.tref->operand[0].oprval.ilit)
{
stx_error(ERR_ACTOFFSET);
return FALSE;
}
}
} else /* DO _ @dlabel actuallist */
{
assert(OC_COMMARG == calltrip->opcode);
assert(TRIP_REF == calltrip->operand[1].oprclass);
assert(OC_ILIT == calltrip->operand[1].oprval.tref->opcode);
assert(ILIT_REF == calltrip->operand[1].oprval.tref->operand[0].oprclass);
assert((mint)indir_do == calltrip->operand[1].oprval.tref->operand[0].oprval.ilit);
assert(calltrip->exorder.fl == &tmpchain);
routineref = maketriple(OC_CURRHD);
labelref = maketriple(OC_LABADDR);
ref0 = maketriple(OC_PARAMETER);
dqins(calltrip->exorder.bl, exorder, routineref);
dqins(calltrip->exorder.bl, exorder, labelref);
dqins(calltrip->exorder.bl, exorder, ref0);
labelref->operand[0] = calltrip->operand[0];
labelref->operand[1] = put_tref(ref0);
ref0->operand[0] = calltrip->operand[1];
ref0->operand[0].oprval.tref->operand[0].oprval.ilit = 0;
ref0->operand[1] = put_tref(routineref);
calltrip->operand[0] = put_tref(routineref);
calltrip->operand[1] = put_tref(labelref);
}
calltrip->opcode = OC_EXTEXCAL;
ref0 = newtriple(OC_PARAMETER);
ref0->operand[0] = calltrip->operand[1];
calltrip->operand[1] = put_tref(ref0);
}
if (!actuallist(&ref0->operand[1]))
return FALSE;
} else if (OC_CALL == calltrip->opcode)
{
calltrip->operand[1] = put_ocnt();
if (TREF(for_stack_ptr) != TADR(for_stack))
{
if (TAREF1(for_temps, (TREF(for_stack_ptr) - TADR(for_stack))))
calltrip->opcode = OC_FORLCLDO;
}
}
if (TK_COLON == window_token)
{
advancewindow();
cr = (oprtype *)mcalloc(SIZEOF(oprtype));
if (!bool_expr((bool) FALSE, cr))
return FALSE;
if (TREF(expr_start) != TREF(expr_start_orig))
{
triptr = newtriple(OC_GVRECTARG);
triptr->operand[0] = put_tref(TREF(expr_start));
}
obp = oldchain->exorder.bl;
dqadd(obp, &tmpchain, exorder); /*this is a violation of info hiding*/
if (OC_EXCAL == calltrip->opcode)
{
triptr = newtriple(OC_JMP);
triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */
tripsize->operand[0].oprval.tsize->ct = triptr;
}
if (TREF(expr_start) != TREF(expr_start_orig))
{
ref0 = newtriple(OC_JMP);
ref1 = newtriple(OC_GVRECTARG);
ref1->operand[0] = put_tref(TREF(expr_start));
*cr = put_tjmp(ref1);
tnxtarg(&ref0->operand[0]);
} else
tnxtarg(cr);
} else
{
obp = oldchain->exorder.bl;
dqadd(obp, &tmpchain, exorder); /*this is a violation of info hiding*/
if (OC_EXCAL == calltrip->opcode)
{
triptr = newtriple(OC_JMP);
triptr->operand[0] = put_mfun(&calltrip->operand[0].oprval.lab->mvname);
calltrip->operand[0].oprclass = ILIT_REF; /* dummy placeholder */
tripsize->operand[0].oprval.tsize->ct = triptr;
}
}
return TRUE;
}
