*/ void Init_Mold(REBCNT size)
/*
***********************************************************************/
{
REBYTE *cp;
REBYTE c;
REBYTE *dc;
Set_Root_Series(TASK_MOLD_LOOP, Make_Block(size/10), cb_cast("mold loop"));
Set_Root_Series(TASK_BUF_MOLD, Make_Unicode(size), cb_cast("mold buffer"));
// Create quoted char escape table:
Char_Escapes = cp = Make_Mem(MAX_ESC_CHAR+1); // cleared
for (c = '@'; c <= '_'; c++) *cp++ = c;
Char_Escapes[TAB] = '-';
Char_Escapes[LF] = '/';
Char_Escapes['"'] = '"';
Char_Escapes['^'] = '^';
URL_Escapes = cp = Make_Mem(MAX_URL_CHAR+1); // cleared
//for (c = 0; c <= MAX_URL_CHAR; c++) if (IS_LEX_DELIMIT(c)) cp[c] = ESC_URL;
for (c = 0; c <= ' '; c++) cp[c] = ESC_URL | ESC_FILE;
dc = b_cast(";%\"()[]{}<>");
for (c = (REBYTE)LEN_BYTES(dc); c > 0; c--) URL_Escapes[*dc++] = ESC_URL | ESC_FILE;
}
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);
}
*/ DEVICE_CMD Read_DNS(REBREQ *sock)
/*
** Initiate the GetHost request and return immediately.
** Note the temporary results buffer (must be freed later).
**
***********************************************************************/
{
char *host;
#ifdef HAS_ASYNC_DNS
HANDLE handle;
#else
HOSTENT *he;
#endif
host = OS_ALLOC_ARRAY(char, MAXGETHOSTSTRUCT); // be sure to free it
#ifdef HAS_ASYNC_DNS
if (!GET_FLAG(sock->modes, RST_REVERSE)) // hostname lookup
handle = WSAAsyncGetHostByName(Event_Handle, WM_DNS, s_cast(sock->common.data), host, MAXGETHOSTSTRUCT);
else
handle = WSAAsyncGetHostByAddr(Event_Handle, WM_DNS, s_cast(&sock->special.net.remote_ip), 4, AF_INET, host, MAXGETHOSTSTRUCT);
if (handle != 0) {
sock->special.net.host_info = host;
sock->requestee.handle = handle;
return DR_PEND; // keep it on pending list
}
#else
// Use old-style blocking DNS (mainly for testing purposes):
if (GET_FLAG(sock->modes, RST_REVERSE)) {
he = gethostbyaddr(
cast(char*, &sock->special.net.remote_ip), 4, AF_INET
);
if (he) {
sock->special.net.host_info = host; //???
sock->common.data = b_cast(he->h_name);
SET_FLAG(sock->flags, RRF_DONE);
return DR_DONE;
}
}
//
// 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;
}
*/ REBYTE * OS_Read_Embedded (REBI64 *script_size)
/*
***********************************************************************/
{
#ifdef __LP64__
Elf64_Ehdr file_header;
Elf64_Shdr *sec_headers;
#else
Elf32_Ehdr file_header;
Elf32_Shdr *sec_headers;
#endif
#define PAYLOAD_NAME ".EmbEddEdREbol"
FILE *script = NULL;
size_t nbytes = 0;
int i = 0;
char *ret = NULL;
char *embedded_script = NULL;
size_t sec_size;
char *shstr;
script = fopen("/proc/self/exe", "r");
if (script == NULL) return NULL;
nbytes = fread(&file_header, sizeof(file_header), 1, script);
if (nbytes < 1) {
fclose(script);
return NULL;
}
sec_size = cast(size_t, file_header.e_shnum) * file_header.e_shentsize;
#ifdef __LP64__
sec_headers = cast(Elf64_Shdr*, OS_ALLOC_ARRAY(char, sec_size));
#else
sec_headers = cast(Elf32_Shdr*, OS_ALLOC_ARRAY(char, sec_size));
#endif
if (sec_headers == NULL) {
fclose(script);
return NULL;
}
if (fseek(script, file_header.e_shoff, SEEK_SET) < 0) {
OS_FREE(sec_headers);
fclose(script);
return NULL;
}
nbytes = fread(sec_headers, file_header.e_shentsize, file_header.e_shnum, script);
if (nbytes < file_header.e_shnum) {
ret = NULL;
goto header_failed;
}
shstr = OS_ALLOC_ARRAY(char, sec_headers[file_header.e_shstrndx].sh_size);
if (shstr == NULL) {
ret = NULL;
goto header_failed;
}
if (fseek(script, sec_headers[file_header.e_shstrndx].sh_offset, SEEK_SET) < 0) {
ret = NULL;
goto shstr_failed;
}
nbytes = fread(shstr, sec_headers[file_header.e_shstrndx].sh_size, 1, script);
if (nbytes < 1) {
ret = NULL;
goto shstr_failed;
}
for (i = 0; i < file_header.e_shnum; i ++) {
/* check the section name */
if (!strncmp(shstr + sec_headers[i].sh_name, PAYLOAD_NAME, sizeof(PAYLOAD_NAME))) {
*script_size = sec_headers[i].sh_size;
break;
}
}
if (i == file_header.e_shnum) {
ret = NULL;
goto cleanup;
}
/* will be free'ed by RL_Start */
embedded_script = OS_ALLOC_ARRAY(char, sec_headers[i].sh_size);
if (embedded_script == NULL) {
ret = NULL;
goto shstr_failed;
}
if (fseek(script, sec_headers[i].sh_offset, SEEK_SET) < 0) {
ret = NULL;
goto embedded_failed;
}
nbytes = fread(embedded_script, 1, sec_headers[i].sh_size, script);
if (nbytes < sec_headers[i].sh_size) {
ret = NULL;
goto embedded_failed;
}
ret = embedded_script;
goto cleanup;
embedded_failed:
OS_FREE(embedded_script);
cleanup:
shstr_failed:
OS_FREE(shstr);
header_failed:
OS_FREE(sec_headers);
fclose(script);
return b_cast(ret);
}
//
// Emit_Decimal: C
//
REBINT Emit_Decimal(
REBYTE *cp,
REBDEC d,
REBFLGS flags, // DEC_MOLD_PERCENT, DEC_MOLD_MINIMAL
REBYTE point,
REBINT decimal_digits
) {
REBYTE *start = cp, *sig, *rve;
int e, sgn;
REBINT digits_obtained;
/* sanity checks */
if (decimal_digits < MIN_DIGITS) decimal_digits = MIN_DIGITS;
else if (decimal_digits > MAX_DIGITS) decimal_digits = MAX_DIGITS;
sig = (REBYTE *) dtoa (d, 0, decimal_digits, &e, &sgn, (char **) &rve);
digits_obtained = rve - sig;
/* handle sign */
if (sgn) *cp++ = '-';
if (flags & DEC_MOLD_PERCENT) e += 2;
if ((e > decimal_digits) || (e <= -6)) {
/* e-format */
*cp++ = *sig++;
/* insert the radix point */
*cp++ = point;
/* insert the rest */
memcpy(cp, sig, digits_obtained - 1);
cp += digits_obtained - 1;
} else if (e > 0) {
if (e <= digits_obtained) {
/* insert digits preceding point */
memcpy (cp, sig, e);
cp += e;
sig += e;
*cp++ = point;
/* insert digits following point */
memcpy(cp, sig, digits_obtained - e);
cp += digits_obtained - e;
} else {
/* insert all digits obtained */
memcpy (cp, sig, digits_obtained);
cp += digits_obtained;
/* insert zeros preceding point */
memset (cp, '0', e - digits_obtained);
cp += e - digits_obtained;
*cp++ = point;
}
e = 0;
} else {
*cp++ = '0';
*cp++ = point;
memset(cp, '0', -e);
cp -= e;
memcpy(cp, sig, digits_obtained);
cp += digits_obtained;
e = 0;
}
// Add at least one zero after point (unless percent or pair):
if (*(cp - 1) == point) {
if ((flags & DEC_MOLD_PERCENT) || (flags & DEC_MOLD_MINIMAL))
cp--;
else
*cp++ = '0';
}
// Add E part if needed:
if (e) {
*cp++ = 'e';
INT_TO_STR(e - 1, cp);
cp = b_cast(strchr(s_cast(cp), 0));
}
if (flags & DEC_MOLD_PERCENT) *cp++ = '%';
*cp = 0;
return cp - start;
}
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, ':');
}
}
