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