Esempio n. 1
1
*/	REBSER *List_Func_Types(REBVAL *func)
/*
**		Return a block of function arg types.
**		Note: skips 0th entry.
**
***********************************************************************/
{
	REBSER *block;
	REBSER *words = VAL_FUNC_WORDS(func);
	REBCNT n;
	REBVAL *value;
	REBVAL *word;

	block = Make_Block(SERIES_TAIL(words));
	word = BLK_SKIP(words, 1);

	for (n = 1; n < SERIES_TAIL(words); word++, n++) {
		value = Alloc_Tail_Blk(block);
		VAL_SET(value, VAL_TYPE(word));
		VAL_WORD_SYM(value) = VAL_BIND_SYM(word);
		UNBIND(value);
	}

	return block;
}
Esempio n. 2
0
static REBOOL same_fields(REBSER *tgt, REBSER *src)
{
	struct Struct_Field *tgt_fields = (struct Struct_Field *) SERIES_DATA(tgt);
	struct Struct_Field *src_fields = (struct Struct_Field *) SERIES_DATA(src);
	REBCNT n;

	if (SERIES_TAIL(tgt) != SERIES_TAIL(src)) {
		return FALSE;
	}

	for(n = 0; n < SERIES_TAIL(src); n ++) {
		if (tgt_fields[n].type != src_fields[n].type) {
			return FALSE;
		}
		if (VAL_SYM_CANON(BLK_SKIP(PG_Word_Table.series, tgt_fields[n].sym))
			!= VAL_SYM_CANON(BLK_SKIP(PG_Word_Table.series, src_fields[n].sym))
			|| tgt_fields[n].offset != src_fields[n].offset
			|| tgt_fields[n].dimension != src_fields[n].dimension
			|| tgt_fields[n].size != src_fields[n].size) {
			return FALSE;
		}
		if (tgt_fields[n].type == STRUCT_TYPE_STRUCT
			&& ! same_fields(tgt_fields[n].fields, src_fields[n].fields)) {
			return FALSE;
		}
	}

	return TRUE;
}
Esempio n. 3
0
File: p-file.c Progetto: mbk/ren-c
*/	static void Write_File_Port(REBREQ *file, REBVAL *data, REBCNT len, REBCNT args)
/*
***********************************************************************/
{
	REBSER *ser;

	if (IS_BLOCK(data)) {
		// Form the values of the block
		// !! Could be made more efficient if we broke the FORM
		// into 32K chunks for writing.
		REB_MOLD mo;
		CLEARS(&mo);
		Reset_Mold(&mo);
		if (args & AM_WRITE_LINES) {
			mo.opts = 1 << MOPT_LINES;
		}
		Mold_Value(&mo, data, 0);
		Set_String(data, mo.series); // fall into next section
		len = SERIES_TAIL(mo.series);
	}

	// Auto convert string to UTF-8
	if (IS_STRING(data)) {
		ser = Encode_UTF8_Value(data, len, ENCF_OS_CRLF);
		file->common.data = ser? BIN_HEAD(ser) : VAL_BIN_DATA(data); // No encoding may be needed
		len = SERIES_TAIL(ser);
	}
	else {
		file->common.data = VAL_BIN_DATA(data);
	}
	file->length = len;
	OS_DO_DEVICE(file, RDC_WRITE);
}
Esempio n. 4
0
static REBSER *Trim_Object(REBSER *obj)
{
	REBVAL *val;
	REBINT cnt = 0;
	REBSER *nobj;
	REBVAL *nval;
	REBVAL *word;
	REBVAL *nwrd;

	word = FRM_WORDS(obj)+1;
	for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
		if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE))
			cnt++;
	}

	nobj = Make_Frame(cnt);
	nval = FRM_VALUES(nobj)+1;
	word = FRM_WORDS(obj)+1;
	nwrd = FRM_WORDS(nobj)+1;
	for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
		if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE)) {
			*nval++ = *val;
			*nwrd++ = *word;
		}
	}
	SET_END(nval);
	SET_END(nwrd);
	SERIES_TAIL(nobj) = cnt+1;
	SERIES_TAIL(FRM_WORD_SERIES(nobj)) = cnt+1;

	return nobj;
}
Esempio n. 5
0
*/  REBSER *Collect_Block_Words(REBVAL *block, REBVAL *prior, REBCNT modes)
/*
**		Collect words from a prior block and new block.
**
***********************************************************************/
{
	REBSER *series;
	REBCNT start;
	REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
	CHECK_BIND_TABLE;

	if (SERIES_TAIL(BUF_WORDS)) Crash(RP_WORD_LIST); // still in use

	if (prior)
		Collect_Simple_Words(prior, BIND_ALL);

	start = SERIES_TAIL(BUF_WORDS);
	Collect_Simple_Words(block, modes);

	// Reset word markers:
	for (block = BLK_HEAD(BUF_WORDS); NOT_END(block); block++)
		binds[VAL_WORD_CANON(block)] = 0;

	series = Copy_Series_Part(BUF_WORDS, start, SERIES_TAIL(BUF_WORDS)-start);
	RESET_TAIL(BUF_WORDS);  // allow reuse

	CHECK_BIND_TABLE;
	return series;
}
Esempio n. 6
0
*/  REBSER *Collect_End(REBSER *prior)
/*
**		Finish collecting words, and free the Bind_Table for reuse.
**
***********************************************************************/
{
	REBVAL *words;
	REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here

	// Reset binding table (note BUF_WORDS may have expanded):
	for (words = BLK_HEAD(BUF_WORDS); NOT_END(words); words++)
		binds[VAL_WORD_CANON(words)] = 0;

	// If no new words, prior frame:
	if (prior && SERIES_TAIL(BUF_WORDS) == SERIES_TAIL(prior)) {
		RESET_TAIL(BUF_WORDS);  // allow reuse
		return FRM_WORD_SERIES(prior);
	}

	prior = Copy_Series(BUF_WORDS);
	RESET_TAIL(BUF_WORDS);  // allow reuse
	BARE_SERIES(prior); // No GC ever needed for word list

	CHECK_BIND_TABLE;

	return prior;
}
Esempio n. 7
0
*/	void Enline_Uni(REBSER *ser, REBCNT idx, REBCNT len)
/*
***********************************************************************/
{
	REBCNT cnt = 0;
	REBUNI *bp;
	REBUNI c = 0;
	REBCNT tail;

	// Calculate the size difference by counting the number of LF's
	// that have no CR's in front of them.
	bp = UNI_SKIP(ser, idx);
	for (; len > 0; len--) {
		if (*bp == LF && c != CR) cnt++;
		c = *bp++;
	}
	if (cnt == 0) return;

	// Extend series:
	len = SERIES_TAIL(ser); // before expansion
	EXPAND_SERIES_TAIL(ser, cnt);
	tail = SERIES_TAIL(ser); // after expansion
	bp = UNI_HEAD(ser); // expand may change it

	// Add missing CRs:
	while (cnt > 0) {
		bp[tail--] = bp[len]; // Copy src to dst.
		if (bp[len] == LF && (len == 0 || bp[len - 1] != CR)) {
			bp[tail--] = CR;
			cnt--;
		}
		len--;
	}
}
Esempio n. 8
0
*/  REBSER *Collect_Words(REBVAL value[], REBVAL prior_value[], REBCNT modes)
/*
**		Collect words from a prior block and new block.
**
***********************************************************************/
{
	REBSER *series;
	REBCNT start;
	REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
	CHECK_BIND_TABLE;

	if (SERIES_TAIL(BUF_WORDS)) panic Error_0(RE_WORD_LIST); // still in use

	if (prior_value)
		Collect_Words_Inner_Loop(binds, &prior_value[0], BIND_ALL);

	start = SERIES_TAIL(BUF_WORDS);
	Collect_Words_Inner_Loop(binds, &value[0], modes);

	// Reset word markers:
	for (value = BLK_HEAD(BUF_WORDS); NOT_END(value); value++)
		binds[VAL_WORD_CANON(value)] = 0;

	series = Copy_Array_At_Max_Shallow(
		BUF_WORDS, start, SERIES_TAIL(BUF_WORDS) - start
	);
	RESET_TAIL(BUF_WORDS);  // allow reuse

	CHECK_BIND_TABLE;
	return series;
}
Esempio n. 9
0
xx*/	REBSER *Make_Func_Words(REBSER *spec)
/*
**		Make a word list part of a context block for a function spec.
**		This series is stored in the ARGS field of the function value.
**
***********************************************************************/
{
	REBVAL *word = BLK_HEAD(spec);
	REBSER *words;
	REBCNT n;
	REBCNT len = 0;

	// Count the number of words within the spec:
	for (n = 0; n < SERIES_TAIL(spec); n++) {
		if (ANY_WORD(word+n)) len++;
	}

	// Make the words table:
	words = Make_Words(len+1);

	// Skip 0th entry (because 0 is not valid for bind index).
	len = 1;
	WORDS_HEAD(words)[0] = 0;

	// Initialize the words in the new table.
	for (n = 0; n < SERIES_TAIL(spec); n++) {
		if (ANY_WORD(word+n)) WORDS_HEAD(words)[len++] = n;
	}
	SERIES_TAIL(words) = len;
	return words;
}
Esempio n. 10
0
*/	void Set_Error_Type(ERROR_OBJ *error)
/*
**		Sets error type and id fields based on code number.
**
***********************************************************************/
{
	REBSER *cats;		// Error catalog object
	REBSER *cat;		// Error category object
	REBCNT n;		// Word symbol number
	REBCNT code;

	code = VAL_INT32(&error->code);

	// Set error category:
	n = code / 100 + 1;
	cats = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));

	if (code >= 0 && n < SERIES_TAIL(cats) &&
		NZ(cat = VAL_SERIES(BLK_SKIP(cats, n)))
	) {
		Set_Word(&error->type, FRM_WORD_SYM(cats, n), cats, n);

		// Find word related to the error itself:
		
		n = code % 100 + 3;
		if (n < SERIES_TAIL(cat))
			Set_Word(&error->id, FRM_WORD_SYM(cat, n), cat, n);
	}
}
Esempio n. 11
0
*/	REBSER *Copy_Wide_Str(void *src, REBINT len)
/*
**		Create a REBOL string series from a wide char string.
**		Minimize to bytes if possible
*/
{
    REBSER *dst;
    REBUNI *str = (REBUNI*)src;
    if (Is_Wide(str, len)) {
        REBUNI *up;
        dst = Make_Unicode(len);
        SERIES_TAIL(dst) = len;
        up = UNI_HEAD(dst);
        while (len-- > 0) *up++ = *str++;
        *up = 0;
    }
    else {
        REBYTE *bp;
        dst = Make_Binary(len);
        SERIES_TAIL(dst) = len;
        bp = BIN_HEAD(dst);
        while (len-- > 0) *bp++ = (REBYTE)*str++;
        *bp = 0;
    }
    return dst;
}
Esempio n. 12
0
*/  REBSER *Merge_Frames(REBSER *parent1, REBSER *parent2)
/*
**      Create a child frame from two parent frames. Merge common fields.
**      Values from the second parent take precedence.
**
**		Deep copy and rebind the child.
**
***********************************************************************/
{
	REBSER *wrds;
	REBSER *child;
	REBVAL *words;
	REBVAL *value;
	REBCNT n;
	REBINT *binds = WORDS_HEAD(Bind_Table);

	// Merge parent1 and parent2 words.
	// Keep the binding table.
	Collect_Start(BIND_ALL);
	// Setup binding table and BUF_WORDS with parent1 words:
	if (parent1) Collect_Object(parent1);
	// Add parent2 words to binding table and BUF_WORDS:
	Collect_Words(BLK_SKIP(FRM_WORD_SERIES(parent2), 1), BIND_ALL);

	// Allocate child (now that we know the correct size):
	wrds = Copy_Series(BUF_WORDS);
	child = Make_Block(SERIES_TAIL(wrds));
	value = Append_Value(child);
	VAL_SET(value, REB_FRAME);
	VAL_FRM_WORDS(value) = wrds;
	VAL_FRM_SPEC(value) = 0;

	// Copy parent1 values:
	COPY_VALUES(FRM_VALUES(parent1)+1, FRM_VALUES(child)+1, SERIES_TAIL(parent1)-1);

	// Copy parent2 values:
	words = FRM_WORDS(parent2)+1;
	value = FRM_VALUES(parent2)+1;
	for (; NOT_END(words); words++, value++) {
		// no need to search when the binding table is available
		n = binds[VAL_WORD_CANON(words)];
		BLK_HEAD(child)[n] = *value;
	}

	// Terminate the child frame:
	SERIES_TAIL(child) = SERIES_TAIL(wrds);
	BLK_TERM(child);

	// Deep copy the child
	Copy_Deep_Values(child, 1, SERIES_TAIL(child), TS_CLONE);

	// Rebind the child
	Rebind_Block(parent1, child, BLK_SKIP(child, 1), REBIND_FUNC);
	Rebind_Block(parent2, child, BLK_SKIP(child, 1), REBIND_FUNC | REBIND_TABLE);

	// release the bind table 
	Collect_End(wrds);

	return child;
}
Esempio n. 13
0
*/  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;
}
Esempio n. 14
0
*/	REBCNT Find_Byte_Str(REBSER *series, REBCNT index, REBYTE *b2, REBCNT l2, REBFLG uncase, REBFLG match)
/*
**		Find a byte string within a byte string. Optimized for speed.
**
**		Returns starting position or NOT_FOUND.
**
**		Uncase: compare is case-insensitive.
**		Match: compare to first position only.
**
**		NOTE: Series tail must be > index.
**
***********************************************************************/
{
	REBYTE *b1;
	REBYTE *e1;
	REBCNT l1;
	REBYTE c;
	REBCNT n;

	// The pattern empty or is longer than the target:
	if (l2 == 0 || (l2 + index) > SERIES_TAIL(series)) return NOT_FOUND;

	b1 = BIN_SKIP(series, index);
	l1 = SERIES_TAIL(series) - index;

	e1 = b1 + (match ? 1 : l1 - (l2 - 1));

	c = *b2; // first char

	if (!uncase) {

		while (b1 != e1) {
			if (*b1 == c) { // matched first char
				for (n = 1; n < l2; n++) {
					if (b1[n] != b2[n]) break;
				}
				if (n == l2) return (b1 - BIN_HEAD(series));
			}
			b1++;
		}

	} else {

		c = (REBYTE)LO_CASE(c); // OK! (never > 255)

		while (b1 != e1) {
			if (LO_CASE(*b1) == c) { // matched first char
				for (n = 1; n < l2; n++) {
					if (LO_CASE(b1[n]) != LO_CASE(b2[n])) break;
				}
				if (n == l2) return (b1 - BIN_HEAD(series));
			}
			b1++;
		}

	}

	return NOT_FOUND;
}
Esempio n. 15
0
*/	REBINT PD_String(REBPVS *pvs)
/*
***********************************************************************/
{
	REBVAL *data = pvs->value;
	REBVAL *val = pvs->setval;
	REBINT n = 0;
	REBCNT i;
	REBINT c;
	REBSER *ser = VAL_SERIES(data);

	if (IS_INTEGER(pvs->select)) {
		n = Int32(pvs->select) + VAL_INDEX(data) - 1;
	}
	else return PE_BAD_SELECT;

	if (val == 0) {
		if (n < 0 || (REBCNT)n >= SERIES_TAIL(ser)) return PE_NONE;
		if (IS_BINARY(data)) {
			SET_INTEGER(pvs->store, *BIN_SKIP(ser, n));
		} else {
			SET_CHAR(pvs->store, GET_ANY_CHAR(ser, n));
		}
		return PE_USE;
	}

	if (n < 0 || (REBCNT)n >= SERIES_TAIL(ser)) return PE_BAD_RANGE;

	if (IS_CHAR(val)) {
		c = VAL_CHAR(val);
		if (c > MAX_CHAR) return PE_BAD_SET;
	}
	else if (IS_INTEGER(val)) {
		c = Int32(val);
		if (c > MAX_CHAR || c < 0) return PE_BAD_SET;
		if (IS_BINARY(data)) { // special case for binary
			if (c > 0xff) Trap_Range(val);
			BIN_HEAD(ser)[n] = (REBYTE)c;
			return PE_OK;
		}
	}
	else if (ANY_BINSTR(val)) {
		i = VAL_INDEX(val);
		if (i >= VAL_TAIL(val)) return PE_BAD_SET;
		c = GET_ANY_CHAR(VAL_SERIES(val), i);
	}
	else
		return PE_BAD_SELECT;

	TRAP_PROTECT(ser);

	if (BYTE_SIZE(ser) && c > 0xff) Widen_String(ser);
	SET_ANY_CHAR(ser, n, c);

	return PE_OK;
}
Esempio n. 16
0
*/	static REBSER *Init_Loop(REBVAL *spec, REBVAL *body_blk, REBSER **fram)
/*
**		Initialize standard for loops (copy block, make frame, bind).
**		Spec: WORD or [WORD ...]
**
***********************************************************************/
{
	REBSER *frame;
	REBINT len;
	REBVAL *word;
	REBVAL *vals;
	REBSER *body;

	// For :WORD format, get the var's value:
	if (IS_GET_WORD(spec)) spec = Get_Var(spec);

	// Hand-make a FRAME (done for for speed):
	len = IS_BLOCK(spec) ? VAL_LEN(spec) : 1;
	if (len == 0) Trap_Arg(spec);
	frame = Make_Frame(len);
	SET_SELFLESS(frame);
	SERIES_TAIL(frame) = len+1;
	SERIES_TAIL(FRM_WORD_SERIES(frame)) = len+1;

	// Setup for loop:
	word = FRM_WORD(frame, 1); // skip SELF
	vals = BLK_SKIP(frame, 1);
	if (IS_BLOCK(spec)) spec = VAL_BLK_DATA(spec);

	// Optimally create the FOREACH frame:
	while (len-- > 0) {
		if (!IS_WORD(spec) && !IS_SET_WORD(spec)) {
			// Prevent inconsistent GC state:
			Free_Series(FRM_WORD_SERIES(frame));
			Free_Series(frame);
			Trap_Arg(spec);
		}
		VAL_SET(word, VAL_TYPE(spec));
		VAL_BIND_SYM(word) = VAL_WORD_SYM(spec);
		VAL_BIND_TYPESET(word) = ALL_64;
		word++;
		SET_NONE(vals);
		vals++;
		spec++;
	}
	SET_END(word);
	SET_END(vals);

	body = Clone_Block_Value(body_blk);
	Bind_Block(frame, BLK_HEAD(body), BIND_DEEP);

	*fram = frame;

	return body;
}
Esempio n. 17
0
*/	static REBSER *Init_Loop(const REBVAL *spec, REBVAL *body_blk, REBSER **fram)
/*
**		Initialize standard for loops (copy block, make frame, bind).
**		Spec: WORD or [WORD ...]
**
***********************************************************************/
{
	REBSER *frame;
	REBINT len;
	REBVAL *word;
	REBVAL *vals;
	REBSER *body;

	// For :WORD format, get the var's value:
	if (IS_GET_WORD(spec)) spec = GET_VAR(spec);

	// Hand-make a FRAME (done for for speed):
	len = IS_BLOCK(spec) ? VAL_LEN(spec) : 1;
	if (len == 0) raise Error_Invalid_Arg(spec);
	frame = Make_Frame(len, FALSE);
	SERIES_TAIL(frame) = len+1;
	SERIES_TAIL(FRM_WORD_SERIES(frame)) = len+1;

	// Setup for loop:
	word = FRM_WORD(frame, 1); // skip SELF
	vals = BLK_SKIP(frame, 1);
	if (IS_BLOCK(spec)) spec = VAL_BLK_DATA(spec);

	// Optimally create the FOREACH frame:
	while (len-- > 0) {
		if (!IS_WORD(spec) && !IS_SET_WORD(spec)) {
			// Prevent inconsistent GC state:
			Free_Series(FRM_WORD_SERIES(frame));
			Free_Series(frame);
			raise Error_Invalid_Arg(spec);
		}
		Val_Init_Word_Typed(word, VAL_TYPE(spec), VAL_WORD_SYM(spec), ALL_64);
		word++;
		SET_NONE(vals);
		vals++;
		spec++;
	}
	SET_END(word);
	SET_END(vals);

	body = Copy_Array_At_Deep_Managed(
		VAL_SERIES(body_blk), VAL_INDEX(body_blk)
	);
	Bind_Values_Deep(BLK_HEAD(body), frame);

	*fram = frame;

	return body;
}
Esempio n. 18
0
xx*/	void Dump_Bind_Table()
/*
***********************************************************************/
{
	REBCNT	n;
	REBINT *binds = WORDS_HEAD(Bind_Table);

	Debug_Fmt("Bind Table (Size: %d)", SERIES_TAIL(Bind_Table));
	for (n = 1; n < SERIES_TAIL(Bind_Table); n++) {
		if (binds[n])
			Debug_Fmt("Bind: %3d to %3d (%s)", n, binds[n], Get_Sym_Name(n));
	}
}
Esempio n. 19
0
*/	REBCNT Find_Block_Simple(REBSER *series, REBCNT index, REBVAL *target)
/*
**		Simple search for a value in a block. Return the index of
**		the value or the TAIL index if not found.
**
***********************************************************************/
{
	REBVAL *value = BLK_HEAD(series);

	for (; index < SERIES_TAIL(series); index++) {
		if (0 == Cmp_Value(value+index, target, FALSE)) return index;
	}

	return SERIES_TAIL(series);
}
Esempio n. 20
0
*/  REBSER *Decompress(REBSER *input, REBCNT index, REBINT len, REBCNT limit, REBFLG use_crc)
/*
**      Decompress a binary (only).
**
***********************************************************************/
{
	REBCNT size;
	REBSER *output;
	REBINT err;

	if (len < 0 || (index + len > BIN_LEN(input))) len = BIN_LEN(input) - index;

	// Get the size from the end and make the output buffer that size.
	if (len <= 4) Trap0(RE_PAST_END); // !!! better msg needed
	size = Bytes_To_Long(BIN_SKIP(input, len) - 4);

	if (limit && size > limit) Trap_Num(RE_SIZE_LIMIT, size); 

	output = Make_Binary(size + 20); // (Why 20 extra? -CS)

	//DISABLE_GC;
	err = Z_uncompress(BIN_HEAD(output), (uLongf*)&size, BIN_HEAD(input) + index, len, use_crc);
	if (err) {
		if (PG_Boot_Phase < 2) return 0;
		if (err == Z_MEM_ERROR) Trap0(RE_NO_MEMORY);
		SET_INTEGER(DS_RETURN, err);
		Trap1(RE_BAD_PRESS, DS_RETURN); //!!!provide error string descriptions
	}
	SET_STR_END(output, size);
	SERIES_TAIL(output) = size;
	//ENABLE_GC;
	return output;
}
Esempio n. 21
0
STOID Form_Block_Series(REBSER *blk, REBCNT index, REB_MOLD *mold, REBSER *frame)
{
	// Form a series (part_mold means mold non-string values):
	REBINT n;
	REBINT len = SERIES_TAIL(blk) - index;
	REBVAL *val;
	REBVAL *wval;

	if (len < 0) len = 0;

	for (n = 0; n < len;) {
		val = BLK_SKIP(blk, index+n);
		wval = 0;
		if (frame && (IS_WORD(val) || IS_GET_WORD(val))) {
			wval = Find_Word_Value(frame, VAL_WORD_SYM(val));
			if (wval) val = wval;
		}
		Mold_Value(mold, val, wval != 0);
		n++;
		if (GET_MOPT(mold, MOPT_LINES)) {
			Append_Byte(mold->series, LF);
		}
		else {
			// Add a space if needed:
			if (n < len && mold->series->tail
				&& *UNI_LAST(mold->series) != LF
				&& !GET_MOPT(mold, MOPT_TIGHT)
			)
				Append_Byte(mold->series, ' ');
		}
	}
}
Esempio n. 22
0
STOID Sniff_String(REBSER *ser, REBCNT idx, REB_STRF *sf)
{
	// Scan to find out what special chars the string contains?
	REBYTE *bp = STR_HEAD(ser);
	REBUNI *up = (REBUNI*)bp;
	REBUNI c;
	REBCNT n;

	for (n = idx; n < SERIES_TAIL(ser); n++) {
		c = (BYTE_SIZE(ser)) ? (REBUNI)(bp[n]) : up[n];
		switch (c) {
		case '{':
			sf->brace_in++;
			break;
		case '}':
			sf->brace_out++;
			if (sf->brace_out > sf->brace_in) sf->malign++;
			break;
		case '"':
			sf->quote++;
			break;
		case '\n':
			sf->newline++;
			break;
		default:
			if (c == 0x1e) sf->chr1e += 4; // special case of ^(1e)
			else if (IS_CHR_ESC(c)) sf->escape++;
			else if (c >= 0x1000) sf->paren += 6; // ^(1234)
			else if (c >= 0x100)  sf->paren += 5; // ^(123)
			else if (c >= 0x80)   sf->paren += 4; // ^(12)
		}
	}
	if (sf->brace_in != sf->brace_out) sf->malign++;
}
Esempio n. 23
0
*/	REBFLG Check_Bit(REBSER *bset, REBCNT c, REBFLG uncased)
/*
**		Check bit indicated. Returns TRUE if set.
**		If uncased is TRUE, try to match either upper or lower case.
**
***********************************************************************/
{
	REBCNT i, n = c;
	REBCNT tail = SERIES_TAIL(bset);
	REBFLG flag = 0;

	if (uncased) {
		if (n >= UNICODE_CASES) uncased = FALSE; // no need to check
		else n = LO_CASE(c);
	}

	// Check lowercase char:
retry:
	i = n >> 3;
	if (i < tail)
		flag = (0 != (BIN_HEAD(bset)[i] & (1 << (7 - ((n) & 7)))));

	// Check uppercase if needed:
	if (uncased && !flag) {
		n = UP_CASE(c);
		uncased = FALSE;
		goto retry;
	}

	return (BITS_NOT(bset)) ? !flag : flag;
}
Esempio n. 24
0
*/	REBINT PD_Object(REBPVS *pvs)
/*
***********************************************************************/
{
	REBINT n = 0;

	if (!VAL_OBJ_FRAME(pvs->value)) {
		return PE_NONE; // Error objects may not have a frame.
	}

	if (IS_WORD(pvs->select)) {
		n = Find_Word_Index(VAL_OBJ_FRAME(pvs->value), VAL_WORD_SYM(pvs->select), FALSE);
	}
//	else if (IS_INTEGER(pvs->select)) {
//		n = Int32s(pvs->select, 1);
//	}
	else return PE_BAD_SELECT;

	if (n <= 0 || (REBCNT)n >= SERIES_TAIL(VAL_OBJ_FRAME(pvs->value)))
		return PE_BAD_SELECT;

	if (pvs->setval && IS_END(pvs->path+1) && VAL_PROTECTED(VAL_FRM_WORD(pvs->value, n)))
		Trap1(RE_LOCKED_WORD, pvs->select);

	pvs->value = VAL_OBJ_VALUES(pvs->value) + n;
	return PE_SET;
	// if setval, check PROTECT mode!!!
	// VAL_FLAGS((VAL_OBJ_VALUES(value) + n)) &= ~FLAGS_CLEAN;
}
Esempio n. 25
0
File: p-file.c Progetto: mbk/ren-c
*/	static void Read_File_Port(REBVAL *out, REBSER *port, REBREQ *file, REBVAL *path, REBCNT args, REBCNT len)
/*
**		Read from a file port.
**
***********************************************************************/
{
	REBSER *ser;

	// Allocate read result buffer:
	ser = Make_Binary(len);
	Set_Series(REB_BINARY, out, ser); //??? what if already set?

	// Do the read, check for errors:
	file->common.data = BIN_HEAD(ser);
	file->length = len;
	if (OS_DO_DEVICE(file, RDC_READ) < 0)
		Trap_Port(RE_READ_ERROR, port, file->error);
	SERIES_TAIL(ser) = file->actual;
	STR_TERM(ser);

	// Convert to string or block of strings.
	// NOTE: This code is incorrect for files read in chunks!!!
	if (args & (AM_READ_STRING | AM_READ_LINES)) {
		REBSER *nser = Decode_UTF_String(BIN_HEAD(ser), file->actual, -1);
		if (nser == NULL) {
			Trap(RE_BAD_DECODE);
		}
		Set_String(out, nser);
		if (args & AM_READ_LINES) Set_Block(out, Split_Lines(out));
	}
}
Esempio n. 26
0
//
//  Find_Key: C
// 
// Returns hash index (either the match or the new one).
// A return of zero is valid (as a hash index);
// 
// Wide: width of record (normally 2, a key and a value).
// 
// Modes:
//     0 - search, return hash if found or not
//     1 - search, return hash, else return -1 if not
//     2 - search, return hash, else append value and return -1
//
REBINT Find_Key(REBSER *series, REBSER *hser, const REBVAL *key, REBINT wide, REBCNT cased, REBYTE mode)
{
    REBCNT *hashes;
    REBCNT skip;
    REBCNT hash;
    REBCNT len;
    REBCNT n;
    REBVAL *val;

    // Compute hash for value:
    len = hser->tail;
    hash = Hash_Value(key, len);
    if (!hash) fail (Error_Has_Bad_Type(key));

    // Determine skip and first index:
    skip  = (len == 0) ? 0 : (hash & 0x0000FFFF) % len;
    if (skip == 0) skip = 1;
    hash = (len == 0) ? 0 : (hash & 0x00FFFF00) % len;

    // Scan hash table for match:
    hashes = (REBCNT*)hser->data;
    if (ANY_WORD(key)) {
        while ((n = hashes[hash])) {
            val = BLK_SKIP(series, (n-1) * wide);
            if (
                ANY_WORD(val) &&
                (VAL_WORD_SYM(key) == VAL_WORD_SYM(val) ||
                (!cased && VAL_WORD_CANON(key) == VAL_WORD_CANON(val)))
            ) return hash;
            hash += skip;
            if (hash >= len) hash -= len;
        }
    }
    else if (ANY_BINSTR(key)) {
        while ((n = hashes[hash])) {
            val = BLK_SKIP(series, (n-1) * wide);
            if (
                VAL_TYPE(val) == VAL_TYPE(key)
                && 0 == Compare_String_Vals(key, val, (REBOOL)(!IS_BINARY(key) && !cased))
            ) return hash;
            hash += skip;
            if (hash >= len) hash -= len;
        }
    } else {
        while ((n = hashes[hash])) {
            val = BLK_SKIP(series, (n-1) * wide);
            if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, !cased)) return hash;
            hash += skip;
            if (hash >= len) hash -= len;
        }
    }

    // Append new value the target series:
    if (mode > 1) {
        hashes[hash] = SERIES_TAIL(series) + 1;
        Append_Values_Len(series, key, wide);
    }

    return (mode > 0) ? NOT_FOUND : hash;
}
Esempio n. 27
0
*/	void Sieve_Ports(REBSER *ports)
/*
**		Remove all ports not found in the WAKE list.
**		ports could be NULL, in which case the WAKE list is cleared.
**
***********************************************************************/
{
	REBVAL *port;
	REBVAL *waked;
	REBVAL *val;
	REBCNT n;

	port = Get_System(SYS_PORTS, PORTS_SYSTEM);
	if (!IS_PORT(port)) return;
	waked = VAL_OBJ_VALUE(port, STD_PORT_DATA);
	if (!IS_BLOCK(waked)) return;

	for (n = 0; ports && n < SERIES_TAIL(ports);) {
		val = BLK_SKIP(ports, n);
		if (IS_PORT(val)) {
			assert(VAL_TAIL(waked) != 0);
			if (VAL_TAIL(waked) == Find_Block_Simple(VAL_SERIES(waked), 0, val)) {//not found
				Remove_Series(ports, n, 1);
				continue;
			}
		}
		n++;
	}
	//clear waked list
	RESET_SERIES(VAL_SERIES(waked));
}
Esempio n. 28
0
*/	static REBFLG Get_Struct_Var(REBSTU *stu, REBVAL *word, REBVAL *val)
/*
***********************************************************************/
{
	struct Struct_Field *field = NULL;
	REBCNT i = 0;
	field = (struct Struct_Field *)SERIES_DATA(stu->fields);
	for (i = 0; i < SERIES_TAIL(stu->fields); i ++, field ++) {
		if (VAL_WORD_CANON(word) == VAL_SYM_CANON(BLK_SKIP(PG_Word_Table.series, field->sym))) {
			if (field->array) {
				REBSER *ser = Make_Array(field->dimension);
				REBCNT n = 0;
				for (n = 0; n < field->dimension; n ++) {
					REBVAL elem;
					get_scalar(stu, field, n, &elem);
					Append_Value(ser, &elem);
				}
				Val_Init_Block(val, ser);
			} else {
				get_scalar(stu, field, 0, val);
			}
			return TRUE;
		}
	}
	return FALSE;
}
Esempio n. 29
0
*/	void Debug_Uni(const REBSER *ser)
/*
**		Print debug unicode string followed by a newline.
**
***********************************************************************/
{
	REBCNT ul;
	REBCNT bl;
	REBYTE buf[1024];
	REBUNI *up = UNI_HEAD(ser);
	REBINT size = Length_As_UTF8(up, SERIES_TAIL(ser), TRUE, OS_CRLF);

	REBINT disabled = GC_Disabled;
	GC_Disabled = 1;

	while (size > 0) {
		ul = Encode_UTF8(buf, MIN(size, 1020), up, &bl, TRUE, OS_CRLF);
		Debug_String(buf, bl, 0, 0);
		size -= ul;
		up += ul;
	}

	Debug_Line();

	assert(GC_Disabled == 1);
	GC_Disabled = disabled;
}
Esempio n. 30
0
*/	REBINT PD_File(REBPVS *pvs)
/*
***********************************************************************/
{
	REBSER *ser;
	REB_MOLD mo = {0};
	REBCNT n;
	REBUNI c;
	REBSER *arg;

	if (pvs->setval) return PE_BAD_SET;

	ser = Copy_Series_Value(pvs->value);

	n = SERIES_TAIL(ser);
	if (n > 0) c = GET_ANY_CHAR(ser, n-1);
	if (n == 0 || c != '/') Append_Byte(ser, '/');

	if (ANY_STR(pvs->select))
		arg = VAL_SERIES(pvs->select);
	else {
		Reset_Mold(&mo);
		Mold_Value(&mo, pvs->select, 0);
		arg = mo.series;
	}

	c = GET_ANY_CHAR(arg, 0);
	n = (c == '/' || c == '\\') ? 1 : 0;
	Append_String(ser, arg, n, arg->tail-n);

	Set_Series(VAL_TYPE(pvs->value), pvs->store, ser);

	return PE_USE;
}