*/ void Dump_Stack(REBINT dsf, REBINT dsp)
/*
***********************************************************************/
{
REBINT n;
REBINT m;
REBVAL *args;
if (dsf == 0) {
dsf = DSF;
dsp = DSP;
}
m = dsp - dsf - DSF_SIZE;
Debug_Fmt(BOOT_STR(RS_STACK, 1), dsp, Get_Word_Name(DSF_WORD(dsf)), m, Get_Type_Name(DSF_FUNC(dsf)));
if (dsf > 0) {
if (ANY_FUNC(DSF_FUNC(dsf))) {
args = BLK_HEAD(VAL_FUNC_ARGS(DSF_FUNC(dsf)));
m = SERIES_TAIL(VAL_FUNC_ARGS(DSF_FUNC(dsf)));
for (n = 1; n < m; n++)
Debug_Fmt("\t%s: %72r", Get_Word_Name(args+n), DSF_ARGS(dsf, n));
}
//Debug_Fmt(Str_Stack[2], PRIOR_DSF(dsf));
if (PRIOR_DSF(dsf) > 0) Dump_Stack(PRIOR_DSF(dsf), dsf-1);
}
//for (n = 1; n <= 2; n++) {
// Debug_Fmt(" ARG%d: %s %r", n, Get_Type_Name(DSF_ARGS(dsf, n)), DSF_ARGS(dsf, n));
//}
}
*/ REBSER *Make_Object(REBSER *parent, REBVAL *block)
/*
** 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 (!block || IS_END(block)) {
object = parent ? Copy_Block_Values(parent, 0, SERIES_TAIL(parent), TS_CLONE) : Make_Frame(0);
} else {
words = Collect_Frame(BIND_ONLY, parent, block); // GC safe
object = Create_Frame(words, 0); // GC safe
if (parent) {
if (Reb_Opts->watch_obj_copy)
Debug_Fmt(BOOT_STR(RS_WATCH, 2), SERIES_TAIL(parent) - 1, FRM_WORD_SERIES(object));
// Copy parent values and deep copy blocks and strings:
COPY_VALUES(FRM_VALUES(parent)+1, FRM_VALUES(object)+1, SERIES_TAIL(parent) - 1);
Copy_Deep_Values(object, 1, SERIES_TAIL(object), TS_CLONE);
}
}
//Dump_Frame(object);
return object;
}
*/ void Dump_Info(void)
/*
***********************************************************************/
{
REBINT n;
REBINT nums [] = {
0,
0,
(REBINT)Eval_Cycles,
Eval_Count,
Eval_Dose,
Eval_Signals,
Eval_Sigmask,
DSP,
DSF,
0,
GC_Ballast,
GC_Disabled,
SERIES_TAIL(GC_Protect),
GC_Last_Infant,
};
DISABLE_GC;
for (n = 0; n < 14; n++) Debug_Fmt(BOOT_STR(RS_DUMP, n), nums[n]);
ENABLE_GC;
}
*/ static void Scan_Error(REBCNT errnum, SCAN_STATE *ss, REBCNT tkn, REBYTE *arg, REBCNT size, REBVAL *relax)
/*
** Scanner error handler
**
***********************************************************************/
{
ERROR_OBJ *error;
REBSER *errs;
REBYTE *name;
REBYTE *cp;
REBYTE *bp;
REBSER *ser;
REBCNT len = 0;
ss->errors++;
if (PG_Boot_Strs)
name = BOOT_STR(RS_SCAN,tkn);
else
name = (REBYTE*)"boot";
cp = ss->head_line;
while (IS_LEX_SPACE(*cp)) cp++; // skip indentation
bp = cp;
while (NOT_NEWLINE(*cp)) cp++, len++;
//DISABLE_GC;
errs = Make_Error(errnum, 0, 0, 0);
error = (ERROR_OBJ *)FRM_VALUES(errs);
ser = Make_Binary(len + 16);
Append_Bytes(ser, "(line ");
Append_Int(ser, ss->line_count);
Append_Bytes(ser, ") ");
Append_Series(ser, (REBYTE*)bp, len);
Set_String(&error->nearest, ser);
Set_String(&error->arg1, Copy_Bytes(name, -1));
Set_String(&error->arg2, Copy_Bytes(arg, size));
if (relax) {
SET_ERROR(relax, errnum, errs);
//ENABLE_GC;
return;
}
Throw_Error(errs); // ENABLE_GC implied
}
//
// 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;
}
*/ void Crash(REBINT id, ...)
/*
** Print a failure message and abort.
**
** LATIN1 ONLY!! (For now)
**
** The error is identified by id number, which can reference an
** error message string in the boot strings block.
**
** Note that lower level error messages should not attempt to
** use the %r (mold value) format (uses higher level functions).
**
** See panics.h for list of crash errors.
**
***********************************************************************/
{
va_list args;
REBYTE buf[CRASH_BUF_SIZE];
REBYTE *msg;
REBINT n = 0;
va_start(args, id);
DISABLE_GC;
if (Reb_Opts->crash_dump) {
Dump_Info();
Dump_Stack(0, 0);
}
// "REBOL PANIC #nnn:"
COPY_BYTES(buf, Crash_Msgs[CM_ERROR], CRASH_BUF_SIZE);
APPEND_BYTES(buf, " #", CRASH_BUF_SIZE);
Form_Int(buf + LEN_BYTES(buf), id);
APPEND_BYTES(buf, ": ", CRASH_BUF_SIZE);
// "REBOL PANIC #nnn: put error message here"
// The first few error types only print general error message.
// Those errors > RP_STR_BASE have specific error messages (from boot.r).
if (id < RP_BOOT_DATA) n = CM_DEBUG;
else if (id < RP_INTERNAL) n = CM_BOOT;
else if (id < RP_ASSERTS) n = CM_INTERNAL;
else if (id < RP_DATATYPE) n = CM_ASSERT;
else if (id < RP_STR_BASE) n = CM_DATATYPE;
else if (id > RP_STR_BASE + RS_MAX - RS_ERROR) n = CM_DEBUG;
// Use the above string or the boot string for the error (in boot.r):
msg = (REBYTE*)(n >= 0 ? Crash_Msgs[n] : BOOT_STR(RS_ERROR, id - RP_STR_BASE - 1));
Form_Var_Args(buf + LEN_BYTES(buf), CRASH_BUF_SIZE - 1 - LEN_BYTES(buf), msg, args);
n = LEN_BYTES(Crash_Msgs[CM_CONTACT]);
if ((LEN_BYTES(buf) + n) < (CRASH_BUF_SIZE - 1))
APPEND_BYTES(buf, Crash_Msgs[CM_CONTACT], n);
// Convert to OS-specific char-type:
#ifdef disable_for_now //OS_WIDE_CHAR /// win98 does not support it
{
REBCHR s1[512];
REBCHR s2[2000];
n = TO_OS_STR(s1, Crash_Msgs[CM_ERROR], LEN_BYTES(Crash_Msgs[CM_ERROR]));
if (n > 0) s1[n] = 0; // terminate
else OS_EXIT(200); // bad conversion
n = TO_OS_STR(s2, buf, LEN_BYTES(buf));
if (n > 0) s2[n] = 0;
else OS_EXIT(200);
OS_CRASH(s1, s2);
}
#else
OS_CRASH(Crash_Msgs[CM_ERROR], buf);
#endif
}
*/ 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;
}
