int m_break(void)
{
if (window_token != TK_SPACE && window_token != TK_EOL)
if (!m_xecute())
return FALSE;
newtriple(OC_BREAK);
if (for_stack_ptr == for_stack)
start_fetches (OC_FETCH);
else
start_for_fetches ();
return TRUE;
}
int m_break(void)
{
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
if ((TK_SPACE != TREF(window_token)) && (TK_EOL != TREF(window_token)))
if (!m_xecute())
return FALSE;
newtriple(OC_BREAK);
if (TREF(for_stack_ptr) == TADR(for_stack))
start_fetches (OC_FETCH);
else
start_for_fetches ();
return TRUE;
}
int comp_fini(bool status, mstr *obj, opctype retcode, oprtype *retopr, int src_len)
{
triple *ref;
error_def(ERR_INDEXTRACHARS);
if (status && source_column != src_len + 2 && source_buffer[source_column] != '\0')
{
status = FALSE;
stx_error(ERR_INDEXTRACHARS);
}
if (status)
{
cg_phase = CGP_RESOLVE;
assert(for_stack_ptr == for_stack);
if (*for_stack_ptr)
tnxtarg(*for_stack_ptr);
ref = newtriple(retcode);
if (retopr)
ref->operand[0] = *retopr;
start_fetches(OC_NOOP);
resolve_ref(0); /* cannot fail because there are no MLAB_REF's in indirect code */
alloc_reg();
stp_gcol(0);
assert(indr_stringpool.base == stringpool.base);
indr_stringpool = stringpool;
stringpool = rts_stringpool;
compile_time = FALSE;
ind_code(obj);
indr_stringpool.free = indr_stringpool.base;
}
else
{
assert(indr_stringpool.base == stringpool.base);
indr_stringpool = stringpool;
stringpool = rts_stringpool;
indr_stringpool.free = indr_stringpool.base;
compile_time = FALSE;
cg_phase = CGP_NOSTATE;
}
transform = TRUE;
mcfree();
return status;
}
/* When in the body of a FOR loop, we need to maintain the binding for the control variable.
* If the action of a command (or function) can alter the symbol table, e.g. BREAK or NEW,
* it should call this routine in preference to start_fetches when it detects that it's in the
* body of a FOR. While start_fetches just starts a new fetch, this copies the arguments of the prior
* fetch to the new fetch because there's no good way to tell which one is for the control variable
*/
void start_for_fetches(void)
{
triple *fetch_trip, *ref1, *ref2;
int fetch_count, idiff, index;
mvax *idx;
fetch_trip = curr_fetch_trip;
fetch_count = curr_fetch_count;
start_fetches(OC_FETCH);
ref1 = fetch_trip;
ref2 = curr_fetch_trip;
idx = mvaxtab;
while (ref1->operand[1].oprclass)
{
assert(ref1->operand[1].oprclass == TRIP_REF);
ref1 = ref1->operand[1].oprval.tref;
assert(ref1->opcode == OC_PARAMETER);
ref2->operand[1] = put_tref (newtriple (OC_PARAMETER));
ref2 = ref2->operand[1].oprval.tref;
ref2->operand[0] = ref1->operand[0];
assert(ref2->operand[0].oprclass == TRIP_REF &&
ref2->operand[0].oprval.tref->opcode == OC_ILIT);
index = ref2->operand[0].oprval.tref->operand[0].oprval.ilit;
idiff = index - idx->mvidx;
while (idx->mvidx != index)
{
if (idiff < 0)
{
assert(idx->last);
idx = idx->last;
idiff++;
} else
{
assert(idx->next);
idx = idx->next;
idiff--;
}
}
assert(idx->mvidx == index);
idx->var->last_fetch = curr_fetch_trip;
}
curr_fetch_count = fetch_count;
curr_fetch_opr = ref2;
}
int comp_fini(int status, mstr *obj, opctype retcode, oprtype *retopr, oprtype *dst, mstr_len_t src_len)
{
triple *ref;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
if (status)
{
while (TK_SPACE == TREF(window_token)) /* Eat up trailing white space */
advancewindow();
if (TK_ERROR == TREF(window_token))
{
status = EXPR_FAIL;
stx_error(ERR_INDRCOMPFAIL);
} else if ((TK_EOL != TREF(window_token)) || (source_column < src_len))
{
status = EXPR_FAIL;
stx_error(ERR_INDEXTRACHARS);
} else
{
cg_phase = CGP_RESOLVE;
assert(TREF(for_stack_ptr) == TADR(for_stack));
if (*TREF(for_stack_ptr))
tnxtarg(*TREF(for_stack_ptr));
ref = newtriple(retcode);
if (retopr)
ref->operand[0] = *retopr;
if (OC_IRETMVAL == retcode)
ref->operand[1] = *dst;
start_fetches(OC_NOOP);
resolve_ref(0); /* cannot fail because there are no MLAB_REF's in indirect code */
alloc_reg();
INVOKE_STP_GCOL(0);
/* The above invocation of stp_gcol with a parameter of 0 is a critical part of compilation
* (both routine compilations and indirect dynamic compilations). This collapses the indirect
* (compilation) stringpool so that only the literals are left. This stringpool is then written
* out to the compiled object as the literal pool for that compilation. Temporary stringpool
* use for conversions or whatever are eliminated. Note the path is different in stp_gcol for
* the indirect stringpool which is only used during compilations.
*/
assert(indr_stringpool.base == stringpool.base);
indr_stringpool = stringpool;
stringpool = rts_stringpool;
TREF(compile_time) = FALSE;
ind_code(obj);
indr_stringpool.free = indr_stringpool.base;
}
} else
{ /* If this assert fails, it means a syntax problem could have been caught earlier. Consider placing a more useful
* and specific error message at that location.
*/
assert(FALSE);
stx_error(ERR_INDRCOMPFAIL);
}
if (EXPR_FAIL == status)
{
assert(indr_stringpool.base == stringpool.base);
indr_stringpool = stringpool;
stringpool = rts_stringpool;
indr_stringpool.free = indr_stringpool.base;
TREF(compile_time) = FALSE;
cg_phase = CGP_NOSTATE;
}
TREF(transform) = TRUE;
COMPILE_HASHTAB_CLEANUP;
mcfree();
return status;
}
boolean_t line(uint4 *lnc)
{
boolean_t success;
int parmcount, varnum;
short int dot_count;
mlabel *x;
mline *curlin;
triple *first_triple, *parmbase, *parmtail, *r;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
first_triple = (TREF(curtchain))->exorder.bl;
dot_count = 0;
parmbase = NULL;
success = TRUE;
curlin = (mline *)mcalloc(SIZEOF(*curlin));
curlin->line_number = 0;
curlin->table = FALSE;
TREF(last_source_column) = 0;
if (TK_INTLIT == TREF(window_token))
int_label();
if ((TK_IDENT == TREF(window_token)) || (cmd_qlf.qlf & CQ_LINE_ENTRY))
start_fetches(OC_LINEFETCH);
else
newtriple(OC_LINESTART);
curlin->line_number = *lnc;
*lnc = *lnc + 1;
curlin->table = TRUE;
CHKTCHAIN(TREF(curtchain));
TREF(pos_in_chain) = *(TREF(curtchain));
if (TK_IDENT == TREF(window_token))
{
x = get_mladdr(&(TREF(window_ident)));
if (x->ml)
{
stx_error(ERR_MULTLAB);
success = FALSE;
} else
{
assert(NO_FORMALLIST == x->formalcnt);
x->ml = curlin;
advancewindow();
if (TK_COLON != TREF(window_token))
mlmax++;
else
{
x->gbl = FALSE;
advancewindow();
}
}
if (success && (TK_LPAREN == TREF(window_token)))
{
advancewindow();
parmbase = parmtail = newtriple(OC_BINDPARM);
for (parmcount = 0; TK_RPAREN != TREF(window_token); parmcount++)
{
if (TK_IDENT != TREF(window_token))
{
stx_error(ERR_NAMEEXPECTED);
success = FALSE;
break;
} else
{
varnum = get_mvaddr(&(TREF(window_ident)))->mvidx;
for (r = parmbase->operand[1].oprval.tref; r; r = r->operand[1].oprval.tref)
{
assert(TRIP_REF == r->operand[0].oprclass);
assert(ILIT_REF == r->operand[0].oprval.tref->operand[0].oprclass);
assert((TRIP_REF == r->operand[1].oprclass) || (0 == r->operand[1].oprclass));
if (r->operand[0].oprval.tref->operand[0].oprval.ilit == varnum)
{
stx_error(ERR_MULTFORMPARM);
success = FALSE;
break;
}
}
if (!success)
break;
r = newtriple(OC_PARAMETER);
parmtail->operand[1] = put_tref(r);
r->operand[0] = put_ilit(varnum);
parmtail = r;
advancewindow();
}
if (TK_COMMA == TREF(window_token))
advancewindow();
else if (TK_RPAREN != TREF(window_token))
{
stx_error(ERR_COMMAORRPAREXP);
success = FALSE;
break;
}
}
if (success)
{
advancewindow();
parmbase->operand[0] = put_ilit(parmcount);
x->formalcnt = parmcount;
assert(!mlabtab->lson);
if ((mlabtab->rson == x) && !TREF(code_generated))
mlabtab->formalcnt = parmcount;
}
}
}
if (success && (TK_EOL != TREF(window_token)))
{
if (TK_SPACE != TREF(window_token))
{
stx_error(ERR_LSEXPECTED);
success = FALSE;
} else
{
assert(0 == dot_count);
for (;;)
{
if (TK_SPACE == TREF(window_token))
advancewindow();
else if (TK_PERIOD == TREF(window_token))
{
dot_count++;
advancewindow();
} else
break;
}
}
if ((block_level + 1) < dot_count)
{
dot_count = (block_level > 0) ? block_level : 0;
stx_error(ERR_BLKTOODEEP);
success = FALSE;
}
}
if ((0 != parmbase) && (0 != dot_count))
{
stx_error(ERR_NESTFORMP); /* Should be warning */
success = FALSE;
dot_count = (block_level > 0 ? block_level : 0);
}
if ((block_level + 1) <= dot_count)
{
mline_tail->child = curlin;
curlin->parent = mline_tail;
block_level = dot_count;
} else
{
for (; dot_count < block_level; block_level--)
mline_tail = mline_tail->parent;
mline_tail->sibling = curlin;
curlin->parent = mline_tail->parent;
}
mline_tail = curlin;
if (success)
{
assert(TREF(for_stack_ptr) == TADR(for_stack));
*(TREF(for_stack_ptr)) = NULL;
success = linetail();
if (success)
{
assert(TREF(for_stack_ptr) == TADR(for_stack));
if (*(TREF(for_stack_ptr)))
tnxtarg(*(TREF(for_stack_ptr)));
}
}
assert(TREF(for_stack_ptr) == TADR(for_stack));
if (first_triple->exorder.fl == TREF(curtchain))
newtriple(OC_NOOP); /* empty line (comment, blank, etc) */
curlin->externalentry = first_triple->exorder.fl;
/* First_triple points to the last triple before this line was processed. Its forward link will point to a
* LINEFETCH or a LINESTART, or possibly a NOOP. It the line was a comment, there is only a LINESTART, and
* hence no "real" code yet.
*/
TREF(code_generated) = TREF(code_generated) | ((OC_NOOP != first_triple->exorder.fl->opcode)
&& (first_triple->exorder.fl->exorder.fl != TREF(curtchain)));
return success;
}
int m_new(void)
{
oprtype tmparg;
triple *ref, *next, *org, *tmp, *s, *fetch;
int n;
int count;
mvar *var;
boolean_t parse_warn;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
switch (window_token)
{
case TK_IDENT:
var = get_mvaddr(&window_ident);
if (var->last_fetch != curr_fetch_trip)
{
fetch = newtriple(OC_PARAMETER);
curr_fetch_opr->operand[1] = put_tref(fetch);
fetch->operand[0] = put_ilit(var->mvidx);
curr_fetch_count++;
curr_fetch_opr = fetch;
var->last_fetch = curr_fetch_trip;
}
tmp = maketriple(OC_NEWVAR);
tmp->operand[0] = put_ilit(var->mvidx);
ins_triple(tmp);
advancewindow();
return TRUE;
case TK_ATSIGN:
if (!indirection(&tmparg))
return FALSE;
ref = maketriple(OC_COMMARG);
ref->operand[0] = tmparg;
ref->operand[1] = put_ilit((mint) indir_new);
ins_triple(ref);
start_fetches(OC_FETCH);
return TRUE;
case TK_DOLLAR:
advancewindow();
if (TK_IDENT == window_token)
{
parse_warn = FALSE;
if ((n = namelook(svn_index, svn_names, window_ident.addr, window_ident.len)) >= 0)
{
switch(svn_data[n].opcode)
{
case SV_ZTRAP:
case SV_ETRAP:
case SV_ESTACK:
case SV_ZYERROR:
case SV_ZGBLDIR:
GTMTRIG_ONLY(case SV_ZTWORMHOLE:)
tmp = maketriple(OC_NEWINTRINSIC);
tmp->operand[0] = put_ilit(svn_data[n].opcode);
break;
default:
STX_ERROR_WARN(ERR_SVNONEW); /* sets "parse_warn" to TRUE */
}
} else
{
STX_ERROR_WARN(ERR_INVSVN); /* sets "parse_warn" to TRUE */
}
advancewindow();
if (!parse_warn)
ins_triple(tmp);
else
{ /* OC_RTERROR triple would have been inserted in curtchain by ins_errtriple
* (invoked by stx_error). No need to do anything else.
*/
assert(OC_RTERROR == curtchain->exorder.bl->exorder.bl->exorder.bl->opcode);
}
return TRUE;
}
int m_new(void)
{
oprtype tmparg;
triple *ref, *next, *org, *tmp, *s, *fetch;
int n;
int count;
mvar *var;
error_def(ERR_INVSVN);
error_def(ERR_RPARENMISSING);
error_def(ERR_VAREXPECTED);
switch (window_token)
{
case TK_IDENT:
var = get_mvaddr(&window_ident);
if (var->last_fetch != curr_fetch_trip)
{
fetch = newtriple(OC_PARAMETER);
curr_fetch_opr->operand[1] = put_tref(fetch);
fetch->operand[0] = put_ilit(var->mvidx);
curr_fetch_count++;
curr_fetch_opr = fetch;
var->last_fetch = curr_fetch_trip;
}
tmp = maketriple(OC_NEWVAR);
tmp->operand[0] = put_ilit(var->mvidx);
ins_triple(tmp);
advancewindow();
return TRUE;
case TK_ATSIGN:
if (!indirection(&tmparg))
return FALSE;
ref = maketriple(OC_COMMARG);
ref->operand[0] = tmparg;
ref->operand[1] = put_ilit((mint) indir_new);
ins_triple(ref);
start_fetches(OC_FETCH);
return TRUE;
case TK_DOLLAR:
advancewindow();
if (window_token == TK_IDENT)
if ((n = namelook(svn_index, svn_names, window_ident.c)) >= 0)
{
tmp = maketriple(OC_NEWINTRINSIC);
switch(svn_data[n].opcode)
{
case SV_ZTRAP:
case SV_ETRAP:
case SV_ESTACK:
case SV_ZYERROR:
case SV_ZGBLDIR:
tmp->operand[0] = put_ilit(svn_data[n].opcode);
break;
default:
stx_error(ERR_INVSVN);
return FALSE;
}
advancewindow();
ins_triple(tmp);
return TRUE;
}
stx_error(ERR_INVSVN);
return FALSE;
case TK_EOL:
case TK_SPACE:
tmp = maketriple(OC_XNEW);
tmp->operand[0] = put_ilit((mint) 0);
ins_triple(tmp);
if (for_stack_ptr == for_stack)
start_fetches (OC_FETCH);
else
start_for_fetches ();
return TRUE;
case TK_LPAREN:
ref = org = maketriple(OC_XNEW);
count = 0;
do
{
advancewindow();
next = maketriple(OC_PARAMETER);
ref->operand[1] = put_tref(next);
switch (window_token)
{
case TK_IDENT:
next->operand[0] = put_str(&window_ident.c[0],sizeof(mident));
advancewindow();
break;
case TK_ATSIGN:
if (!indirection(&tmparg))
return FALSE;
s = newtriple(OC_INDLVARG);
s->operand[0] = tmparg;
next->operand[0] = put_tref(s);
break;
default:
stx_error(ERR_VAREXPECTED);
return FALSE;
}
ins_triple(next);
ref = next;
count++;
} while (window_token == TK_COMMA);
if (window_token != TK_RPAREN)
{
stx_error(ERR_RPARENMISSING);
return FALSE;
}
advancewindow();
org->operand[0] = put_ilit((mint) count);
ins_triple(org);
if (for_stack_ptr == for_stack)
start_fetches (OC_FETCH);
else
start_for_fetches ();
return TRUE;
default:
stx_error(ERR_VAREXPECTED);
return FALSE;
}
}
