*/ 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, ':'); } }