STATICFNDEF void ext_stx_error(int in_error, ...)
{
va_list args;
char *ext_table_name;
char buf[MAX_SRC_LINE], *b;
int num_tabs, num_spaces;
va_start(args, in_error);
ext_table_name = va_arg(args, char *);
va_end(args);
num_tabs = ext_source_column/TABLEN;
num_spaces = ext_source_column%TABLEN;
b = &buf[0];
memset(buf, '\t', num_tabs+2);
b += num_tabs+NUM_TABS_FOR_GTMERRSTR;
memset(b, ' ', num_spaces);
b += num_spaces;
memcpy(b, "^-----", POINTER_SIZE);
b += POINTER_SIZE;
*b = 0;
dec_err(VARLSTCNT(6) ERR_EXTSRCLIN, 4, ext_source_line_len, ext_source_line, b - &buf[0], &buf[0]);
dec_err(VARLSTCNT(6) ERR_EXTSRCLOC, 4, ext_source_column, ext_source_line_num, LEN_AND_STR(ext_table_name));
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) in_error);
}
void compile_source_file(unsigned short flen, char *faddr)
{
plength plen;
mval fstr, ret;
int i;
unsigned char *p;
error_def (ERR_FILEPARSE);
error_def (ERR_FILENOTFND);
error_def (ERR_ERRORSUMMARY);
if (MAX_FBUFF < flen)
{
dec_err(VARLSTCNT(4) ERR_FILEPARSE, 2, flen, faddr);
dollar_zcstatus = ERR_ERRORSUMMARY;
} else
{
fstr.mvtype = MV_STR;
fstr.str.addr = faddr;
fstr.str.len = flen;
ESTABLISH(source_ch);
tt_so_do_once = FALSE;
for (i = 0 ; ; i++)
{
plen.p.pint = op_fnzsearch(&fstr, 0, &ret);
if (!ret.str.len)
{
if (!i)
{
dec_err(VARLSTCNT(4) ERR_FILENOTFND, 2, fstr.str.len, fstr.str.addr);
dollar_zcstatus = ERR_ERRORSUMMARY;
}
break;
}
assert(ret.mvtype == MV_STR);
assert(ret.str.len <= MAX_FBUFF);
source_name_len = ret.str.len;
memcpy(source_file_name, ret.str.addr, source_name_len);
source_file_name[source_name_len] = 0;
p = &source_file_name[plen.p.pblk.b_dir];
if ((plen.p.pblk.b_dir >= sizeof("/dev/") - 1) && !MEMCMP_LIT(source_file_name, "/dev/"))
tt_so_do_once = TRUE;
else if (plen.p.pblk.b_ext != 2
|| ('M' != p[plen.p.pblk.b_name + 1] && 'm' != p[plen.p.pblk.b_name + 1]))
{
dec_err(VARLSTCNT(4) ERR_FILEPARSE, 2, source_name_len, source_file_name);
dollar_zcstatus = ERR_ERRORSUMMARY;
continue;
}
if (compiler_startup())
dollar_zcstatus = ERR_ERRORSUMMARY;
if (tt_so_do_once)
break;
}
REVERT;
}
}
void show_source_line(char* buf, boolean_t warn)
{
char *b, *c, *c_top;
int chlen, chwidth;
unsigned int ch;
error_def(ERR_SRCLIN);
error_def(ERR_SRCLOC);
for (c = (char *)source_buffer, b = buf, c_top = c + last_source_column - 1; c < c_top; )
{
if (*c == '\t')
*b++ = *c++;
else if (!gtm_utf8_mode || *(uchar_ptr_t)c <= ASCII_MAX)
{
*b++ = ' ';
c++;
}
#ifdef UNICODE_SUPPORTED
else
{
chlen = (int)(UTF8_MBTOWC(c, c_top, ch) - (uchar_ptr_t)c);
if (WEOF != ch && 0 < (chwidth = UTF8_WCWIDTH(ch)))
{
memset(b, ' ', chwidth);
b += chwidth;
}
c += chlen;
}
#endif
}
memcpy(b, ARROW, STR_LIT_LEN(ARROW));
b += STR_LIT_LEN(ARROW);
*b = '\0';
if (warn)
{
dec_nofac = TRUE;
dec_err(VARLSTCNT (6) ERR_SRCLIN, 4, LEN_AND_STR((char *)source_buffer), b - buf, buf);
if (!run_time)
dec_err(VARLSTCNT(6) ERR_SRCLOC, 4, last_source_column, source_line, source_name_len, source_file_name);
dec_nofac = FALSE;
}
}
void show_source_line(boolean_t warn)
{
char *b, *b_top, *c, *c_top, *buf;
char source_line_buff[MAX_SRCLINE + SIZEOF(ARROW)];
ssize_t buflen;
int chlen, chwidth;
unsigned int ch, line_chwidth = 0;
boolean_t unable_to_complete_arrow = FALSE;
mstr msgstr;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
buf = source_line_buff;
buflen = SIZEOF(source_line_buff);
b_top = buf + buflen - STR_LIT_LEN(ARROW) - 1; /* allow room for arrow and string terminator */
for (c = (char *)source_buffer, b = buf, c_top = c + TREF(last_source_column) - 1; c < c_top;)
{
if ('\t' == *c)
{
if ((b + 1) > b_top)
{
unable_to_complete_arrow = TRUE;
break;
}
*b++ = *c++;
}
else if (!gtm_utf8_mode || (ASCII_MAX >= *(uchar_ptr_t)c))
{
if ((b + 1) > b_top)
{
unable_to_complete_arrow = TRUE;
break;
}
*b++ = ' ';
c++;
}
# ifdef UNICODE_SUPPORTED
else
{
chlen = (int)(UTF8_MBTOWC(c, c_top, ch) - (uchar_ptr_t)c);
if (WEOF != ch && (0 < (chwidth = UTF8_WCWIDTH(ch)))) /* assignment */
{
if ((b + chwidth) > b_top)
{
unable_to_complete_arrow = TRUE;
break;
}
memset(b, ' ', chwidth);
b += chwidth;
}
c += chlen;
}
# endif
}
if (unable_to_complete_arrow)
{
msgstr.addr = buf;
msgstr.len = buflen;
dec_nofac = TRUE;
gtm_getmsg(ERR_ARROWNTDSP, &msgstr);
dec_nofac = FALSE;
} else
{
memcpy(b, ARROW, STR_LIT_LEN(ARROW));
b += STR_LIT_LEN(ARROW);
*b = '\0';
}
if (warn)
{
for (c = (char *)source_buffer; c < (char *)source_buffer + STRLEN((char *)source_buffer) - 1; )
{
if ('\t' == *c)
{
line_chwidth++;
c++;
}
else if (!gtm_utf8_mode || (ASCII_MAX >= *(uchar_ptr_t)c))
{
line_chwidth++;
c++;
} else
{
# ifdef UNICODE_SUPPORTED /* funky positioning makes VMS compiler happy */
chlen = (int)(UTF8_MBTOWC(c, (char *)source_buffer + STRLEN((char *)source_buffer) - 1, ch)
- (uchar_ptr_t)c);
if ((WEOF != ch) && 0 < (chwidth = UTF8_WCWIDTH(ch)))
line_chwidth += chwidth;
c += chlen;
# endif
}
}
dec_nofac = TRUE;
if (MAXLINESIZEFORDISPLAY > line_chwidth)
if (unable_to_complete_arrow)
dec_err(VARLSTCNT(6) ERR_SRCLIN, 4, LEN_AND_STR((char *)source_buffer), msgstr.len, msgstr.addr);
else
dec_err(VARLSTCNT(6) ERR_SRCLIN, 4, LEN_AND_STR((char *)source_buffer), b - buf, buf);
else
dec_err(VARLSTCNT(2) ERR_SRCLNNTDSP, 1, MAXLINESIZEFORDISPLAY);
if (!run_time)
dec_err(VARLSTCNT(6) ERR_SRCLOC, 4, TREF(last_source_column), source_line,
source_name_len, source_file_name);
dec_nofac = FALSE;
}
}
void compile_source_file(unsigned short flen, char *faddr, boolean_t MFtIsReqd)
{
plength plen;
mval fstr, ret;
int i, rc;
unsigned char *p;
boolean_t wildcarded, dm_action;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
if (MAX_FBUFF < flen)
{
dec_err(VARLSTCNT(4) ERR_FILEPARSE, 2, flen, faddr);
TREF(dollar_zcstatus) = ERR_ERRORSUMMARY;
} else
{
object_file_des = FD_INVALID;
fstr.mvtype = MV_STR;
fstr.str.addr = faddr;
fstr.str.len = flen;
ESTABLISH(source_ch);
tt_so_do_once = FALSE;
zsrch_clr(STRM_COMP_SRC); /* Clear any existing search cache */
for (i = 0; ; i++)
{
plen.p.pint = op_fnzsearch(&fstr, STRM_COMP_SRC, 0, &ret);
if (!ret.str.len)
{
if (!i)
{
dec_err(VARLSTCNT(4) ERR_FILENOTFND, 2, fstr.str.len, fstr.str.addr);
TREF(dollar_zcstatus) = ERR_ERRORSUMMARY;
}
break;
}
assert(ret.mvtype == MV_STR);
assert(ret.str.len <= MAX_FBUFF);
source_name_len = ret.str.len;
memcpy(source_file_name, ret.str.addr, source_name_len);
source_file_name[source_name_len] = 0;
p = &source_file_name[plen.p.pblk.b_dir];
if ((plen.p.pblk.b_dir >= SIZEOF("/dev/") - 1) && !MEMCMP_LIT(source_file_name, "/dev/"))
tt_so_do_once = TRUE;
else if (MFtIsReqd && (plen.p.pblk.b_ext != 2 || ('M' != p[plen.p.pblk.b_name + 1]
&& 'm' != p[plen.p.pblk.b_name + 1])))
{ /* M filetype is required but not present */
dec_err(VARLSTCNT(4) ERR_FILEPARSE, 2, source_name_len, source_file_name);
TREF(dollar_zcstatus) = ERR_ERRORSUMMARY;
continue;
}
if (compiler_startup())
TREF(dollar_zcstatus) = ERR_ERRORSUMMARY;
if (FD_INVALID != object_file_des)
{
CLOSEFILE_RESET(object_file_des, rc); /* resets "object_file_des" to FD_INVALID */
if (-1 == rc)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(5) ERR_OBJFILERR, 2,
object_name_len, object_file_name, errno);
}
if (tt_so_do_once)
break;
}
REVERT;
}
}
/* routine to convert external return values to mval's */
static void extarg2mval(void *src, enum xc_types typ, mval *dst)
{
int str_len;
int4 s_int_num;
uint4 uns_int_num;
char *cp;
struct extcall_string *sp;
error_def(ERR_ZCSTATUSRET);
error_def(ERR_MAXSTRLEN);
switch(typ)
{
case xc_notfound:
break;
case xc_void:
break;
case xc_status:
s_int_num = (int4)src;
if (0 != s_int_num)
dec_err(VARLSTCNT(1) ERR_ZCSTATUSRET,0,s_int_num);
MV_FORCE_MVAL(dst, s_int_num);
break;
case xc_long:
s_int_num = (int4)src;
MV_FORCE_MVAL(dst, s_int_num);
break;
case xc_ulong:
uns_int_num = (uint4)src;
MV_FORCE_ULONG_MVAL(dst, uns_int_num);
break;
case xc_long_star:
s_int_num = *((int4 *)src);
MV_FORCE_MVAL(dst, s_int_num);
break;
case xc_ulong_star:
uns_int_num = *((uint4 *)src);
MV_FORCE_ULONG_MVAL(dst, uns_int_num);
break;
case xc_string_star:
sp = (struct extcall_string *)src;
dst->mvtype = MV_STR;
if (sp->len > MAX_STRLEN)
rts_error(VARLSTCNT(1) ERR_MAXSTRLEN);
dst->str.len = sp->len;
if ((0 < sp->len) && (NULL != sp->addr))
{
dst->str.addr = sp->addr;
s2pool(&dst->str);
}
break;
case xc_float_star:
double2mval(dst, (double)*((float *)src));
break;
case xc_char_star:
cp = (char *)src;
assert(((int)cp < (int)stringpool.base) || ((int)cp > (int)stringpool.top));
dst->mvtype = MV_STR;
str_len = strlen(cp);
if (str_len > MAX_STRLEN)
rts_error(VARLSTCNT(1) ERR_MAXSTRLEN);
dst->str.len = str_len;
dst->str.addr = cp;
s2pool(&dst->str);
break;
case xc_char_starstar:
if (!src)
dst->mvtype = 0;
else
extarg2mval(*((char **)src), xc_char_star, dst);
break;
case xc_double_star:
double2mval(dst, *((double *)src));
break;
default:
rts_error(VARLSTCNT(1) ERR_UNIMPLOP);
break;
}
return;
}
/* This function issues a BADCHAR error and prints the sequences of bytes that comprise the bad multi-byte character.
* If "len" is 0, the function determines how many bytes this multi-byte character is comprised of and prints all of it.
* If "len" is non-zero, the function prints "len" number of bytes from "str" in the error message.
* This is the work-horse routine for the 3 above variants of utf8_badchar*(). The differences are in how the error
* is delivered and what happens afterwards. For the 3 options:
*
* err_rts - uses rts_error() to raise the error
* err_stx - uses stx_error to raise the error
* err_dec - uses dec_err to raise the error
*/
STATICFNDEF void utf8_badchar_real(utf8_err_type err_type, int len, unsigned char *str, unsigned char *strtop, int chset_len,
unsigned char *chset)
{
unsigned char *strptr, *strend, *outstr;
unsigned char errtxt[OUT_BUFF_SIZE];
int tmplen;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert(gtm_utf8_mode);
if (0 == len)
{ /* Determine the maximal length (upto 4 bytes) of the invalid byte sequence */
for (strend = str; len <= 4 && strend < strtop; ++strend, ++len)
{
if (UTF8_VALID(strend, strtop, tmplen))
break;
}
} else
strend = str + len;
strptr = str;
outstr = &errtxt[0];
for (; strptr < strend; ++strptr, ++outstr)
{
outstr = (unsigned char*)i2asc((uchar_ptr_t)outstr, *strptr);
*outstr = ',';
}
if (0 < len) /* do not include the last comma */
outstr--;
if (err_dec == err_type)
{
assert(NULL != show_source_line_fptr);
(*show_source_line_fptr)(TRUE); /* Prints errant source line and pointer to where parsing detected the error */
}
if (0 < chset_len)
{
switch(err_type)
{
case err_rts:
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(6) ERR_BADCHAR, 4, (outstr - &errtxt[0]), &errtxt[0],
chset_len, chset);
break; /* Never get here but keeps compiler happy */
case err_stx:
assert(NULL != stx_error_fptr);
(*stx_error_fptr)(ERR_BADCHAR, 4, (outstr - &errtxt[0]), &errtxt[0], chset_len, chset);
break;
case err_dec:
dec_err(VARLSTCNT(6) (TREF(compile_time) ? MAKE_MSG_TYPE(ERR_BADCHAR, WARNING) : ERR_BADCHAR),
4, (outstr - &errtxt[0]), &errtxt[0], chset_len, chset);
break;
default:
assertpro(FALSE /* Invalid error type */);
}
} else
{
switch(err_type)
{
case err_rts:
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(6) ERR_BADCHAR, 4, (outstr - &errtxt[0]), &errtxt[0],
LEN_AND_LIT(UTF8_NAME));
break; /* Never get here but keeps compiler happy */
case err_stx:
assert(NULL != stx_error_fptr);
(*stx_error_fptr)(ERR_BADCHAR, 4, (outstr - &errtxt[0]), &errtxt[0], LEN_AND_LIT(UTF8_NAME));
break;
case err_dec:
dec_err(VARLSTCNT(6) (TREF(compile_time) ? MAKE_MSG_TYPE(ERR_BADCHAR, WARNING) : ERR_BADCHAR),
4, (outstr - &errtxt[0]), &errtxt[0], LEN_AND_LIT(UTF8_NAME));
break;
default:
assertpro(FALSE /* Invalid error type */);
}
}
}
void compile_source_file(unsigned short flen, char *faddr, boolean_t mExtReqd /* not used in VMS */)
{
struct FAB srch_fab;
struct NAM srch_nam;
char exp_string_area[255], list_file[256], obj_file[256], ceprep_file[256];
int status;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
obj_fab = cc$rms_fab;
srch_fab = cc$rms_fab;
srch_fab.fab$l_dna = DOTM;
srch_fab.fab$b_dns = STR_LIT_LEN(DOTM);
srch_fab.fab$l_fna = faddr;
srch_fab.fab$b_fns = flen;
srch_fab.fab$l_fop |= FAB$M_NAM;
srch_fab.fab$l_nam = &srch_nam;
srch_nam = cc$rms_nam;
srch_nam.nam$l_rsa = source_file_name;
srch_nam.nam$b_rss = NAME_MAX; /* 255 since PATH_MAX is 256 on 7.3-2 */
srch_nam.nam$l_esa = exp_string_area;
srch_nam.nam$b_ess = SIZEOF(exp_string_area);
status = sys$parse(&srch_fab);
if (RMS$_NORMAL != status)
{ dec_err(VARLSTCNT(4) ERR_SRCFILERR, 2, source_name_len, source_file_name);
dec_err(VARLSTCNT(1) status);
TREF(dollar_zcstatus) = ERR_ERRORSUMMARY;
} else
{
cmd_qlf.object_file.str.addr = obj_file;
cmd_qlf.object_file.str.len = 255;
cmd_qlf.list_file.str.addr = list_file;
cmd_qlf.list_file.str.len = 255;
cmd_qlf.ceprep_file.str.addr = ceprep_file;
cmd_qlf.ceprep_file.str.len = 255;
get_cmd_qlf(&cmd_qlf);
tt_so_do_once = FALSE;
for (; ;)
{
if (srch_fab.fab$l_dev & DEV$M_FOD)
{ status = sys$search(&srch_fab);
if (status == RMS$_NMF )
{ break;
}
else if (status == RMS$_FNF)
{ dec_err(VARLSTCNT(4) ERR_FILENOTFND, 2, srch_nam.nam$b_esl, srch_nam.nam$l_esa);
TREF(dollar_zcstatus) = ERR_ERRORSUMMARY;
break;
}
else if (status != RMS$_NORMAL)
{ dec_err(VARLSTCNT(4) ERR_SRCFILERR, 2, source_name_len, source_file_name);
dec_err(VARLSTCNT(1) status);
TREF(dollar_zcstatus) = ERR_ERRORSUMMARY;
break;
}
else
{ source_name_len = srch_nam.nam$b_rsl;
source_file_name[source_name_len] = '\0';
}
} else
{ source_name_len = SIZEOF("SYS$INPUT");
memcpy(source_file_name, "SYS$INPUT", source_name_len);
source_file_name[source_name_len] = '\0';
tt_so_do_once = TRUE;
}
if (compiler_startup())
TREF(dollar_zcstatus) = ERR_ERRORSUMMARY;
else
{
status = sys$close(&obj_fab);
obj_fab = cc$rms_fab;
if (RMS$_NORMAL != status)
rts_error(VARLSTCNT(6) ERR_OBJFILERR, 2, object_name_len, object_file_name, status,
obj_fab.fab$l_stv);
}
if (tt_so_do_once)
break;
}
}
}
bool open_source_file(void)
{
static readonly char inprompt[] = "\015\012>";
struct NAM nam;
struct XABDAT xab;
char exp_name[255];
char *p;
int n;
int rms_status;
struct dsc$descriptor_s t_desc
= {REV_TIME_BUFF_LEN, DSC$K_DTYPE_T, DSC$K_CLASS_S, rev_time_buf};
fab = cc$rms_fab;
fab.fab$l_fna = source_file_name;
fab.fab$b_fns = source_name_len;
fab.fab$w_mrs = MAX_SRCLINE;
fab.fab$l_xab = &xab;
fab.fab$l_nam = &nam;
nam = cc$rms_nam;
nam.nam$l_esa = exp_name;
nam.nam$b_ess = SIZEOF(exp_name);
xab = cc$rms_xabdat;
rms_status = sys$open(&fab);
fab.fab$l_xab = 0;
fab.fab$l_nam = 0;
if (RMS$_NORMAL != rms_status)
{
dec_err(VARLSTCNT(4) ERR_SRCFILERR, 2, source_name_len, source_file_name);
dec_err(VARLSTCNT(1) rms_status);
return FALSE;
}
assert(tt_so_do_once || (source_name_len == nam.nam$b_esl && !memcmp(source_file_name, exp_name, nam.nam$b_esl)));
rab = cc$rms_rab;
rab.rab$l_fab = &fab;
rab.rab$l_pbf = inprompt;
rab.rab$b_psz = SIZEOF(inprompt) - 1;
rab.rab$l_rop = RAB$M_PMT;
rab.rab$l_ubf = source_buffer;
rab.rab$w_usz = MAX_SRCLINE;
rms_status = sys$connect(&rab);
if (RMS$_NORMAL != rms_status)
{
dec_err(VARLSTCNT(4) ERR_SRCFILERR, 2, source_name_len, source_file_name);
dec_err(VARLSTCNT(1) rms_status);
return FALSE;
}
sys$asctim(0,&t_desc,&xab.xab$q_rdt,0);
p = nam.nam$l_name ;
n = nam.nam$b_name ;
if (n > MAX_MIDENT_LEN)
n = MAX_MIDENT_LEN;
else if (!n)
{
p = "MDEFAULT";
n = STR_LIT_LEN("MDEFAULT");
}
memcpy(routine_name.addr, p, n);
memcpy(module_name.addr, p, n);
routine_name.len = module_name.len = n;
if ('_' == *p)
routine_name.addr[0] = '%';
return TRUE;
}
void trans_code_cleanup(void)
{
stack_frame *fp;
uint4 err;
error_def(ERR_STACKCRIT);
error_def(ERR_ERRWZTRAP);
error_def(ERR_ERRWETRAP);
error_def(ERR_ERRWIOEXC);
assert(!(SFT_ZINTR & proc_act_type));
/* With no extra ztrap frame being pushed onto stack, we may miss error(s)
* during trans_code if we don't check proc_act_type in addition to
* frame_pointer->type below.
*/
if (SFT_ZTRAP == proc_act_type)
{
if (0 < dollar_ztrap.str.len)
err = (int)ERR_ERRWZTRAP;
else
{
assert(0 < dollar_etrap.str.len);
err = (int)ERR_ERRWETRAP;
}
frame_pointer->flags |= SFF_ZTRAP_ERR;
} else if (SFT_DEV_ACT == proc_act_type)
{
err = ERR_ERRWIOEXC;
frame_pointer->flags |= SFF_DEV_ACT_ERR;
} else
err = 0;
proc_act_type = 0;
if (compile_time)
{
compile_time = FALSE;
if (stringpool.base != rts_stringpool.base)
stringpool = rts_stringpool;
}
for (fp = frame_pointer; fp; fp = fp->old_frame_pointer)
{
if (fp->type & SFT_DM)
break;
if (fp->type & SFT_COUNT)
{
assert(NULL != err_act);
if (!IS_ETRAP)
dm_setup();
break;
}
if (fp->type)
{
SET_ERR_CODE(fp, err);
}
/* If this frame is indicated for cache cleanup, do that cleanup
now before we get rid of the pointers used by that cleanup.
*/
IF_INDR_FRAME_CLEANUP_CACHE_ENTRY_AND_UNMARK(fp);
fp->mpc = CODE_ADDRESS(pseudo_ret);
fp->ctxt = CONTEXT(pseudo_ret);
}
transform = TRUE;
if (err)
dec_err(VARLSTCNT(1) err);
}
void trans_code_cleanup(void)
{
stack_frame *fp, *fpprev;
uint4 errmsg;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert(!(SFT_ZINTR & proc_act_type));
/* With no extra ztrap frame being pushed onto stack, we may miss error(s)
* during trans_code if we don't check proc_act_type in addition to
* frame_pointer->type below.
*/
if (SFT_ZTRAP == proc_act_type)
{
if (0 < dollar_ztrap.str.len)
errmsg = ERR_ERRWZTRAP;
else
errmsg = ERR_ERRWETRAP;
} else if (SFT_DEV_ACT == proc_act_type)
errmsg = ERR_ERRWIOEXC;
else
errmsg = 0;
proc_act_type = 0;
if (TREF(compile_time))
{
TREF(compile_time) = FALSE;
if (stringpool.base != rts_stringpool.base)
stringpool = rts_stringpool;
}
for (fp = frame_pointer; fp; fp = fpprev)
{
fpprev = fp->old_frame_pointer;
# ifdef GTM_TRIGGER
if (SFT_TRIGR & fpprev->type)
fpprev = *(stack_frame **)(fpprev + 1);
# endif
if (fp->type & SFT_DM)
break;
if (fp->type & SFT_COUNT)
{
if ((ERR_ERRWZTRAP == errmsg) || (ERR_ERRWETRAP == errmsg))
{ /* Whether ETRAP or ZTRAP we want to rethrow the error at one level down */
SET_ERROR_FRAME(fp); /* reset error_frame to point to the closest counted frame */
assert(fp->flags & SFF_ETRAP_ERR);
/* Turn off any device exception related flags now that we are going to handle errors using
* $ETRAP or $ZTRAP AT THE PARENT LEVEL only (no more device exceptions).
*/
dollar_ztrap.str.len = 0;
ztrap_explicit_null = FALSE;
fp->flags &= SFF_DEV_ACT_ERR_OFF;
fp->flags &= SFF_ZTRAP_ERR_OFF;
err_act = &dollar_etrap.str;
break;
} else if (ERR_ERRWIOEXC == errmsg)
{ /* Error while compiling device exception. Set SFF_ETRAP_ERR bit so control is transferred to
* error_return() which in turn will rethrow the error AT THE SAME LEVEL in order to try and
* use $ZTRAP or $ETRAP whichever is active. Also set the SFF_DEV_ACT_ERR bit to signify this
* is a device exception that is rethrown instead of a ztrap/etrap error. Also assert that
* the rethrow will not use IO exception again (thereby ensuring error processing will
* eventually terminate instead of indefinitely recursing).
*/
fp->flags |= (SFF_DEV_ACT_ERR | SFF_ETRAP_ERR);
assert(NULL == active_device); /* mdb_condition_handler should have reset it */
break;
} else if ((ERR_ERRWZBRK == errmsg) || (ERR_ERRWEXC == errmsg))
{ /* For typical exceptions in ZBREAK and ZSTEP, get back to direct mode */
dm_setup();
break;
} else
{ /* The only known way to be here is if the command is a command given in direct mode as
* mdb_condition_handler won't drive an error handler in that case which would be caught in
* one of the above conditions. Not breaking out of the loop here means the frame will just
* unwind and we'll break on the direct mode frame which will be redriven. If the parent frame
* is not a direct mode frame, we'll assert in debug or break in pro and just continue.
* to direct mode.
*/
assert(fp->flags && (SFF_INDCE));
if (!fp->old_frame_pointer || !(fp->old_frame_pointer->type & SFT_DM))
{
assert(FALSE);
break;
}
}
}
if (fp->type)
{
SET_ERR_CODE(fp, errmsg);
}
/* If this frame is indicated for cache cleanup, do that cleanup
* now before we get rid of the pointers used by that cleanup.
*/
IF_INDR_FRAME_CLEANUP_CACHE_ENTRY_AND_UNMARK(fp);
fp->mpc = CODE_ADDRESS(pseudo_ret);
fp->ctxt = GTM_CONTEXT(pseudo_ret);
fp->flags &= SFF_IMPLTSTART_CALLD_OFF; /* Frame enterable now with mpc reset */
GTMTRIG_ONLY(DBGTRIGR((stderr, "trans_code_cleanup: turning off SFF_IMPLTSTART_CALLD in frame 0x"lvaddr"\n",
frame_pointer)));
}
TREF(transform) = TRUE;
if (0 != errmsg)
dec_err(VARLSTCNT(1) errmsg);
}
