*/ void Dump_Values(REBVAL *vp, REBCNT count)
/*
** Dump raw values into a string buffer;
**
***********************************************************************/
{
REBYTE buf[2048];
REBYTE *cp;
REBCNT l, n;
REBCNT *bp = (REBCNT*)vp;
cp = buf;
for (l = 0; l < count; l++) {
cp = Form_Hex_Pad(cp, (REBCNT) bp, 8);
*cp++ = ':';
*cp++ = ' ';
for (n = 0; n < 4; n++) {
cp = Form_Hex_Pad(cp, *bp++, 8);
*cp++ = ' ';
}
*cp++ = '\n';
if ((cp - buf) >= 2040) break;
}
*cp++ = 0;
Debug_Str(buf);
}
*/ void Dump_Values(REBVAL *vp, REBCNT count)
/*
** Print out values in raw hex; If memory is corrupted
** this function still needs to work.
**
***********************************************************************/
{
REBYTE buf[2048];
REBYTE *cp;
REBCNT l, n;
REBCNT *bp = (REBCNT*)vp;
REBYTE *type;
cp = buf;
for (l = 0; l < count; l++) {
cp = Form_Hex_Pad(cp, (REBCNT) l, 4);
*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 < 4; n++) {
cp = Form_Hex_Pad(cp, *bp++, 8);
*cp++ = ' ';
}
*cp = 0;
Debug_Str(buf);
cp = buf;
}
}
xx*/ void Print_Dump_Value(REBVAL *value, REBYTE *label)
/*
** Dump a value's contents for debugging purposes.
**
***********************************************************************/
{
REBSER *series;
series = Copy_Bytes(label, -1);
SAVE_SERIES(series);
series = Dump_Value(value, series);
Debug_Str(STR_HEAD(series));
UNSAVE_SERIES(series);
}
*/ void Dump_Bytes(REBYTE *bp, REBCNT limit)
/*
** Dump memory into a string buffer;
**
***********************************************************************/
{
#ifdef _DEBUG
REBYTE buf[20480];
REBYTE str[40];
REBYTE *cp, *tp;
REBYTE c;
REBCNT l, n;
REBCNT cnt = 0;
cp = buf;
for (l = 0; l < 150; l++) {
cp = Form_Hex_Pad(cp, (REBCNT) bp, 8);
*cp++ = ':';
*cp++ = ' ';
tp = str;
for (n = 0; n < 16; n++) {
if (cnt++ >= limit) break;
c = *bp++;
cp = Form_Hex2(cp, c);
if ((n & 3) == 3) *cp++ = ' ';
if ((c < 32) || (c > 126)) c = '.';
*tp++ = c;
}
for (; n < 16; n++) {
c = ' ';
*cp++ = c;
*cp++ = c;
if ((n & 3) == 3) *cp++ = ' ';
if ((c < 32) || (c > 126)) c = '.';
*tp++ = c;
}
*tp++ = 0;
for (tp = str; *tp;) *cp++ = *tp++;
*cp++ = '\n';
if (cnt >= limit) break;
}
*cp++ = 0;
Debug_Str(buf);
#endif
}
*/ void Do_Native(REBVAL *func)
/*
***********************************************************************/
{
REBVAL *ds;
REBINT n;
#ifdef DEBUGGING
REBYTE *fname = Get_Word_Name(DSF_WORD(DSF)); // for DEBUG
Debug_Str(fname);
#endif
Eval_Natives++;
if (NZ(n = VAL_FUNC_CODE(func)(DS_RETURN))) {
ds = DS_RETURN;
switch (n) {
case R_RET: // for compiler opt
break;
case R_TOS:
*ds = *DS_TOP;
break;
case R_TOS1:
*ds = *DS_NEXT;
break;
case R_NONE:
SET_NONE(ds);
break;
case R_UNSET:
SET_UNSET(ds);
break;
case R_TRUE:
SET_TRUE(ds);
break;
case R_FALSE:
SET_FALSE(ds);
break;
case R_ARG1:
*ds = *D_ARG(1);
break;
case R_ARG2:
*ds = *D_ARG(2);
break;
case R_ARG3:
*ds = *D_ARG(3);
break;
}
}
}
*/ void Dump_Bytes(REBYTE *bp, REBCNT limit)
/*
***********************************************************************/
{
const max_lines = 120;
REBYTE buf[2048];
REBYTE str[40];
REBYTE *cp, *tp;
REBYTE c;
REBCNT l, n;
REBCNT cnt = 0;
cp = buf;
for (l = 0; l < max_lines; l++) {
cp = Form_Hex_Pad(cp, (REBCNT) bp, 8);
*cp++ = ':';
*cp++ = ' ';
tp = str;
for (n = 0; n < 16; n++) {
if (cnt++ >= limit) break;
c = *bp++;
cp = Form_Hex2(cp, c);
if ((n & 3) == 3) *cp++ = ' ';
if ((c < 32) || (c > 126)) c = '.';
*tp++ = c;
}
for (; n < 16; n++) {
c = ' ';
*cp++ = c;
*cp++ = c;
if ((n & 3) == 3) *cp++ = ' ';
if ((c < 32) || (c > 126)) c = '.';
*tp++ = c;
}
*tp++ = 0;
for (tp = str; *tp;) *cp++ = *tp++;
*cp = 0;
Debug_Str(buf);
if (cnt >= limit) break;
cp = buf;
}
}
*/ void Init_Pools(REBINT scale)
/*
** Initialize memory pool array.
**
***********************************************************************/
{
REBCNT n;
REBINT unscale = 1;
#ifndef NDEBUG
const char *env_always_malloc = NULL;
env_always_malloc = getenv("R3_ALWAYS_MALLOC");
if (env_always_malloc != NULL) {
Debug_Str(
"**\n"
"** R3_ALWAYS_MALLOC is TRUE in environment variable!\n"
"** Memory allocations aren't pooled, expect slowness...\n"
"**\n"
);
PG_Always_Malloc = (atoi(env_always_malloc) != 0);
}
#endif
if (scale == 0) scale = 1;
else if (scale < 0) unscale = -scale, scale = 1;
// Copy pool sizes to new pool structure:
Mem_Pools = ALLOC_ARRAY(REBPOL, MAX_POOLS);
for (n = 0; n < MAX_POOLS; n++) {
Mem_Pools[n].wide = Mem_Pool_Spec[n].wide;
Mem_Pools[n].units = (Mem_Pool_Spec[n].units * scale) / unscale;
if (Mem_Pools[n].units < 2) Mem_Pools[n].units = 2;
}
// For pool lookup. Maps size to pool index. (See Find_Pool below)
PG_Pool_Map = ALLOC_ARRAY(REBYTE, (4 * MEM_BIG_SIZE) + 4); // extra
n = 9; // sizes 0 - 8 are pool 0
for (; n <= 16 * MEM_MIN_SIZE; n++) PG_Pool_Map[n] = MEM_TINY_POOL + ((n-1) / MEM_MIN_SIZE);
for (; n <= 32 * MEM_MIN_SIZE; n++) PG_Pool_Map[n] = MEM_SMALL_POOLS-4 + ((n-1) / (MEM_MIN_SIZE * 4));
for (; n <= 4 * MEM_BIG_SIZE; n++) PG_Pool_Map[n] = MEM_MID_POOLS + ((n-1) / MEM_BIG_SIZE);
}
*/ void Debug_Series(const REBSER *ser)
/*
***********************************************************************/
{
REBINT disabled = GC_Disabled;
GC_Disabled = 1;
// This routine is also a little catalog of the outlying series
// types in terms of sizing, just to know what they are.
if (BYTE_SIZE(ser))
Debug_Str(s_cast(BIN_HEAD(ser)));
else if (IS_BLOCK_SERIES(ser)) {
REBVAL value;
// May not actually be a REB_BLOCK, but we put it in a value
// container for now saying it is so we can output it. Because
// it may be a frame or otherwise, we use a raw VAL_SET
VAL_SET(&value, REB_BLOCK);
VAL_SERIES(&value) = m_cast(REBSER *, ser); // not actually modifying
VAL_INDEX(&value) = 0;
Debug_Fmt("%r", &value);
} else if (SERIES_WIDE(ser) == sizeof(REBUNI))
//
// 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;
}
}
*/ void Debug_Series(const REBSER *ser)
/*
***********************************************************************/
{
REBINT disabled = GC_Disabled;
GC_Disabled = 1;
// This routine is also a little catalog of the outlying series
// types in terms of sizing, just to know what they are.
if (BYTE_SIZE(ser))
Debug_Str(s_cast(BIN_HEAD(ser)));
else if (Is_Array_Series(ser)) {
REBVAL value;
// May not actually be a REB_BLOCK, but we put it in a value
// container for now saying it is so we can output it. It may be
// a frame and we may not want to Manage_Series here, so we use a
// raw VAL_SET instead of Val_Init_Block
VAL_SET(&value, REB_BLOCK);
VAL_SERIES(&value) = m_cast(REBSER *, ser); // not actually modifying
VAL_INDEX(&value) = 0;
Debug_Fmt("%r", &value);
} else if (SERIES_WIDE(ser) == sizeof(REBUNI))
xx*/ void Dump_Block(REBVAL *blk, REBINT len)
/*
** Dump a block's contents for debugging purposes.
**
***********************************************************************/
{
REBSER *series;
//REBVAL *blk = BLK_HEAD(block);
//Print("BLOCK: %x Tail: %d Size: %d", block, block->tail, block->rest);
// change to a make string!!! no need to append to a series, this is a debug function
series = Make_Binary(100);
Append_Bytes(series, "[\n");
while (NOT_END(blk) && len-- > 0) {
Append_Byte(series, '\t');
Dump_Value(blk, series);
Append_Byte(series, '\n');
blk++;
}
Append_Byte(series, ']');
*STR_TAIL(series) = 0;
Debug_Str(STR_HEAD(series));
}
