//
// OS_Crash: C
//
// Tell user that REBOL has crashed. This function must use
// the most obvious and reliable method of displaying the
// crash message.
//
// If the title is NULL, then REBOL is running in a server mode.
// In that case, we do not want the crash message to appear on
// the screen, because the system may be unattended.
//
// On some systems, the error may be recorded in the system log.
//
// coverity[+kill]
//
void OS_Crash(const REBYTE *title, const REBYTE *content)
{
// Echo crash message if echo file is open:
///PUTE(content);
OS_Call_Device(RDI_STDIO, RDC_CLOSE); // close echo
// A title tells us we should alert the user:
if (title) {
fputs(cs_cast(title), stderr);
fputs(":\n", stderr);
}
fputs(cs_cast(content), stderr);
fputs("\n\n", stderr);
#ifdef HAVE_EXECINFO_AVAILABLE // backtrace is a GNU extension.
{
void *backtrace_buf[1024];
int n_backtrace = backtrace(backtrace_buf, sizeof(backtrace_buf)/sizeof(backtrace_buf[0]));
fputs("Backtrace:\n", stderr);
backtrace_symbols_fd(backtrace_buf, n_backtrace, STDERR_FILENO);
}
#endif
exit(EXIT_FAILURE);
}
//
// OS_Crash: C
//
// Tell user that REBOL has crashed. This function must use
// the most obvious and reliable method of displaying the
// crash message.
//
// If the title is NULL, then REBOL is running in a server mode.
// In that case, we do not want the crash message to appear on
// the screen, because the system may be unattended.
//
// On some systems, the error may be recorded in the system log.
//
void OS_Crash(const REBYTE *title, const REBYTE *content)
{
// Echo crash message if echo file is open:
///PUTE(content);
OS_Call_Device(RDI_STDIO, RDC_CLOSE); // close echo
// A title tells us we should alert the user:
if (title) {
// OS_Put_Str(title);
// OS_Put_Str(":\n");
// Use ASCII only
MessageBoxA(NULL, cs_cast(content), cs_cast(title), MB_ICONHAND);
}
// OS_Put_Str(content);
exit(100);
}
//
// RL_Print: C
//
// Low level print of formatted data to the console.
//
// Returns:
// nothing
// Arguments:
// fmt - A format string similar but not identical to printf.
// Special options are available.
// ... - Values to be formatted.
// Notes:
// This function is low level and handles only a few C datatypes
// at this time.
//
RL_API void RL_Print(const REBYTE *fmt, ...)
{
va_list va;
va_start(va, fmt);
Debug_Buf(cs_cast(fmt), &va);
va_end(va);
}
STOID Mold_Handle(REBVAL *value, REB_MOLD *mold)
{
const REBYTE *name = VAL_HANDLE_NAME(value);
if (name != NULL) {
Append_Bytes(mold->series, "#[handle! ");
Append_Bytes(mold->series, cs_cast(name));
Append_Byte(mold->series, ']');
}
else {
Emit(mold, "+T", value);
}
}
STOID Mold_Block_Series(REB_MOLD *mold, REBSER *series, REBCNT index, REBYTE *sep)
{
REBSER *out = mold->series;
REBOOL line_flag = FALSE; // newline was part of block
REBOOL had_lines = FALSE;
REBVAL *value = BLK_SKIP(series, index);
if (!sep) sep = b_cast("[]");
if (IS_END(value)) {
Append_Bytes(out, cs_cast(sep));
return;
}
// Recursion check: (variation of: Find_Same_Block(MOLD_LOOP, value))
for (value = BLK_HEAD(MOLD_LOOP); NOT_END(value); value++) {
if (VAL_SERIES(value) == series) {
Emit(mold, "C...C", sep[0], sep[1]);
return;
}
}
value = Append_Value(MOLD_LOOP);
Set_Block(value, series);
if (sep[1]) {
Append_Byte(out, sep[0]);
mold->indent++;
}
// else out->tail--; // why?????
value = BLK_SKIP(series, index);
while (NOT_END(value)) {
if (VAL_GET_LINE(value)) {
if (sep[1] || line_flag) New_Indented_Line(mold);
had_lines = TRUE;
}
line_flag = TRUE;
Mold_Value(mold, value, TRUE);
value++;
if (NOT_END(value))
Append_Byte(out, (sep[0] == '/') ? '/' : ' ');
}
if (sep[1]) {
mold->indent--;
if (VAL_GET_LINE(value) || had_lines) New_Indented_Line(mold);
Append_Byte(out, sep[1]);
}
Remove_Last(MOLD_LOOP);
}
*/ void OS_Crash(const REBYTE *title, const REBYTE *content)
/*
** Tell user that REBOL has crashed. This function must use
** the most obvious and reliable method of displaying the
** crash message.
**
** If the title is NULL, then REBOL is running in a server mode.
** In that case, we do not want the crash message to appear on
** the screen, because the system may be unattended.
**
** On some systems, the error may be recorded in the system log.
**
***********************************************************************/
{
// Echo crash message if echo file is open:
///PUTE(content);
OS_Call_Device(RDI_STDIO, RDC_CLOSE); // close echo
// A title tells us we should alert the user:
if (title) {
fputs(cs_cast(title), stderr);
fputs(":\n", stderr);
}
fputs(cs_cast(content), stderr);
fputs("\n\n", stderr);
#ifdef HAVE_EXECINFO_AVAILABLE // backtrace is a GNU extension.
{
void *backtrace_buf[1024];
int n_backtrace = backtrace(backtrace_buf, sizeof(backtrace_buf)/sizeof(backtrace_buf[0]));
fputs("Backtrace:\n", stderr);
backtrace_symbols_fd(backtrace_buf, n_backtrace, STDERR_FILENO);
}
#endif
exit(EXIT_FAILURE);
}
*/ RL_API void RL_Print(const REBYTE *fmt, ...)
/*
** Low level print of formatted data to the console.
**
** Returns:
** nothing
** Arguments:
** fmt - A format string similar but not identical to printf.
** Special options are available.
** ... - Values to be formatted.
** Notes:
** This function is low level and handles only a few C datatypes
** at this time.
**
***********************************************************************/
{
va_list args;
va_start(args, fmt);
Debug_Buf(cs_cast(fmt), &args);
va_end(args);
}
//
// Dump_Values: C
//
// Print values in raw hex; If memory is corrupted this still needs to work.
//
void Dump_Values(RELVAL *vp, REBCNT count)
{
REBYTE buf[2048];
REBYTE *cp;
REBCNT l, n;
REBCNT *bp = (REBCNT*)vp;
const REBYTE *type;
cp = buf;
for (l = 0; l < count; l++) {
REBVAL *val = cast(REBVAL*, bp);
cp = Form_Hex_Pad(cp, l, 8);
*cp++ = ':';
*cp++ = ' ';
type = Get_Type_Name((REBVAL*)bp);
for (n = 0; n < 11; n++) {
if (*type) *cp++ = *type++;
else *cp++ = ' ';
}
*cp++ = ' ';
for (n = 0; n < sizeof(REBVAL) / sizeof(REBCNT); n++) {
cp = Form_Hex_Pad(cp, *bp++, 8);
*cp++ = ' ';
}
n = 0;
if (IS_WORD(val) || IS_GET_WORD(val) || IS_SET_WORD(val)) {
const REBYTE *name = STR_HEAD(VAL_WORD_SPELLING(val));
n = snprintf(
s_cast(cp), sizeof(buf) - (cp - buf), " (%s)", cs_cast(name)
);
}
*(cp + n) = 0;
Debug_Str(s_cast(buf));
cp = buf;
}
}
//
// Panic_Core: C
//
// (va_list by pointer: http://stackoverflow.com/a/3369762/211160)
//
// Print a failure message and abort. The code adapts to several
// different load stages of the system, and uses simpler ways to
// report the error when the boot has not progressed enough to
// use the more advanced modes. This allows the same interface
// to be used for `panic Error_XXX(...)` and `fail (Error_XXX(...))`.
//
ATTRIBUTE_NO_RETURN void Panic_Core(REBCNT id, REBSER *maybe_frame, va_list *args)
{
char title[PANIC_TITLE_SIZE];
char message[PANIC_MESSAGE_SIZE];
title[0] = '\0';
message[0] = '\0';
if (maybe_frame) {
assert(id == 0);
id = ERR_NUM(maybe_frame);
}
// We are crashing, so a legitimate time to be disabling the garbage
// collector. (It won't be turned back on.)
GC_Disabled++;
if (Reb_Opts && Reb_Opts->crash_dump) {
Dump_Info();
Dump_Stack(0, 0);
}
strncat(title, "PANIC #", PANIC_TITLE_SIZE - 1);
Form_Int(b_cast(title + strlen(title)), id); // !!! no bounding...
strncat(message, Str_Panic_Directions, PANIC_MESSAGE_SIZE - 1);
#if !defined(NDEBUG)
// In debug builds, we may have the file and line number to report if
// the call to Panic_Core originated from the `panic` macro. But we
// will not if the panic is being called from a Make_Error call that
// is earlier than errors can be made...
if (TG_Erroring_C_File) {
Form_Args(
b_cast(message + strlen(message)),
PANIC_MESSAGE_SIZE - 1 - strlen(message),
"C Source File %s, Line %d\n",
TG_Erroring_C_File,
TG_Erroring_C_Line,
NULL
);
}
#endif
if (PG_Boot_Phase < BOOT_LOADED) {
strncat(message, title, PANIC_MESSAGE_SIZE - 1);
strncat(
message,
"\n** Boot Error: (string table not decompressed yet)",
PANIC_MESSAGE_SIZE - 1
);
}
else if (PG_Boot_Phase < BOOT_ERRORS && id < RE_INTERNAL_MAX) {
// We are panic'ing on one of the errors that can occur during
// boot (e.g. before Make_Error() be assured to run). So we use
// the C string constant that was formed by %make-boot.r and
// compressed in the boot block.
//
// Note: These strings currently do not allow arguments.
const char *format =
cs_cast(BOOT_STR(RS_ERROR, id - RE_INTERNAL_FIRST));
assert(args && !maybe_frame);
strncat(message, "\n** Boot Error: ", PANIC_MESSAGE_SIZE - 1);
Form_Args_Core(
b_cast(message + strlen(message)),
PANIC_MESSAGE_SIZE - 1 - strlen(message),
format,
args
);
}
else if (PG_Boot_Phase < BOOT_ERRORS && id >= RE_INTERNAL_MAX) {
strncat(message, title, PANIC_MESSAGE_SIZE - 1);
strncat(
message,
"\n** Boot Error: (error object table not initialized yet)",
PANIC_MESSAGE_SIZE - 1
);
}
else {
// The system should be theoretically able to make and mold errors.
//
// !!! If you're trying to panic *during* error molding this
// is obviously not going to not work. All errors pertaining to
// molding errors should audited to be in the Boot: category.
REBVAL error;
if (maybe_frame) {
assert(!args);
Val_Init_Error(&error, maybe_frame);
}
else {
// We aren't explicitly passed a Rebol ERROR! object, but we
// consider it "safe" to make one since we're past BOOT_ERRORS
Val_Init_Error(&error, Make_Error_Core(id, args));
}
Form_Args(
b_cast(message + strlen(message)),
PANIC_MESSAGE_SIZE - 1 - strlen(message),
"%v",
&error,
NULL
);
}
OS_CRASH(cb_cast(Str_Panic_Title), cb_cast(message));
// Note that since we crash, we never return so that the caller can run
// a va_end on the passed-in args. This is illegal in the general case:
//
// http://stackoverflow.com/a/587139/211160
DEAD_END;
}
STOID Mold_Block(REBVAL *value, REB_MOLD *mold)
{
REBYTE *sep = NULL;
REBOOL all = GET_MOPT(mold, MOPT_MOLD_ALL);
REBSER *series = mold->series;
REBFLG over = FALSE;
if (SERIES_WIDE(VAL_SERIES(value)) == 0)
Crash(RP_BAD_WIDTH, sizeof(REBVAL), 0, VAL_TYPE(value));
// Optimize when no index needed:
if (VAL_INDEX(value) == 0 && !IS_MAP(value)) // && (VAL_TYPE(value) <= REB_LIT_PATH))
all = FALSE;
// If out of range, do not cause error to avoid error looping.
if (VAL_INDEX(value) >= VAL_TAIL(value)) over = TRUE; // Force it into []
if (all || (over && !IS_BLOCK(value) && !IS_PAREN(value))) {
SET_FLAG(mold->opts, MOPT_MOLD_ALL);
Pre_Mold(value, mold); // #[block! part
//if (over) Append_Bytes(mold->series, "[]");
//else
Mold_Block_Series(mold, VAL_SERIES(value), 0, 0);
Post_Mold(value, mold);
}
else
{
switch(VAL_TYPE(value)) {
case REB_MAP:
Pre_Mold(value, mold);
sep = 0;
case REB_BLOCK:
if (GET_MOPT(mold, MOPT_ONLY)) {
CLR_FLAG(mold->opts, MOPT_ONLY); // only top level
sep = b_cast("\000\000");
}
else sep = 0;
break;
case REB_PAREN:
sep = b_cast("()");
break;
case REB_GET_PATH:
series = Append_Byte(series, ':');
sep = b_cast("/");
break;
case REB_LIT_PATH:
series = Append_Byte(series, '\'');
/* fall through */
case REB_PATH:
case REB_SET_PATH:
sep = b_cast("/");
break;
}
if (over) Append_Bytes(mold->series, sep ? cs_cast(sep) : "[]");
else Mold_Block_Series(mold, VAL_SERIES(value), VAL_INDEX(value), sep);
if (VAL_TYPE(value) == REB_SET_PATH)
Append_Byte(series, ':');
}
}
*/ REBSER *Make_Object(REBSER *parent, REBVAL value[])
/*
** Create an object from a parent object and a spec block.
** The words within the resultant object are not bound.
**
***********************************************************************/
{
REBSER *words;
REBSER *object;
PG_Reb_Stats->Objects++;
if (!value || IS_END(value)) {
if (parent) {
object = Copy_Array_Core_Managed(
parent, 0, SERIES_TAIL(parent), TRUE, TS_CLONE
);
}
else {
object = Make_Frame(0, TRUE);
MANAGE_FRAME(object);
}
}
else {
words = Collect_Frame(parent, &value[0], BIND_ONLY); // GC safe
object = Create_Frame(words, 0); // GC safe
if (parent) {
if (Reb_Opts->watch_obj_copy)
Debug_Fmt(cs_cast(BOOT_STR(RS_WATCH, 2)), SERIES_TAIL(parent) - 1, FRM_WORD_SERIES(object));
// Bitwise copy parent values (will have bits fixed by Clonify)
memcpy(
FRM_VALUES(object) + 1,
FRM_VALUES(parent) + 1,
(SERIES_TAIL(parent) - 1) * sizeof(REBVAL)
);
// For values we copied that were blocks and strings, replace
// their series components with deep copies of themselves:
Clonify_Values_Len_Managed(
BLK_SKIP(object, 1), SERIES_TAIL(object) - 1, TRUE, TS_CLONE
);
// The *word series* might have been reused from the parent,
// based on whether any words were added, or we could have gotten
// a fresh one back. Force our invariant here (as the screws
// tighten...)
ENSURE_SERIES_MANAGED(FRM_WORD_SERIES(object));
MANAGE_SERIES(object);
}
else {
MANAGE_FRAME(object);
}
assert(words == FRM_WORD_SERIES(object));
}
ASSERT_SERIES_MANAGED(object);
ASSERT_SERIES_MANAGED(FRM_WORD_SERIES(object));
ASSERT_FRAME(object);
return object;
}
