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; } }