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

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

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

static REBOOL Equal_Object(REBVAL *val, REBVAL *arg)
{
	REBSER *f1;
	REBSER *f2;
	REBSER *w1;
	REBSER *w2;
	REBINT n;

	if (VAL_TYPE(arg) != VAL_TYPE(val)) return FALSE;

	f1 = VAL_OBJ_FRAME(val);
	f2 = VAL_OBJ_FRAME(arg);
	if (f1 == f2) return TRUE;
	if (f1->tail != f2->tail) return FALSE;

	w1 = FRM_WORD_SERIES(f1);
	w2 = FRM_WORD_SERIES(f2);
	if (w1->tail != w2->tail) return FALSE;

	// Compare each entry:
	for (n = 1; n < (REBINT)(f1->tail); n++) {
		if (Cmp_Value(BLK_SKIP(w1, n), BLK_SKIP(w2, n), FALSE)) return FALSE;
		// Use Compare_Values();
		if (Cmp_Value(BLK_SKIP(f1, n), BLK_SKIP(f2, n), FALSE)) return FALSE;
	}

	return TRUE;
}

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 = "[]";

	if (IS_END(value)) {
		Append_Bytes(out, 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);
}

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

*/ RL_API REBYTE *RL_Word_String(u32 word)
/*
**	Return a string related to a given global word identifier.
**
**	Returns:
**		A copy of the word string, null terminated.
**	Arguments:
**		word - a global word identifier
**	Notes:
**		The result is a null terminated copy of the name for your own use.
**		The string is always UTF-8 encoded (chars > 127 are encoded.)
**		In this API, word identifiers are always canonical. Therefore,
**		the returned string may have different spelling/casing than expected.
**		The string is allocated with OS_ALLOC and you can OS_FREE it any time.
**
***********************************************************************/
{
	REBYTE *s1, *s2;
	// !!This code should use a function from c-words.c (but nothing perfect yet.)
	if (word == 0 || word >= PG_Word_Table.series->tail) return 0;
	s1 = VAL_SYM_NAME(BLK_SKIP(PG_Word_Table.series, word));
	s2 = OS_ALLOC_ARRAY(REBYTE, LEN_BYTES(s1) + 1);
	COPY_BYTES(s2, s1, LEN_BYTES(s1) + 1);
	return s2;
}

*/	REBYTE *Get_Sym_Name(REBCNT num)
/*
***********************************************************************/
{
	if (num == 0 || num >= PG_Word_Table.series->tail) return (REBYTE*)"???";
	return VAL_SYM_NAME(BLK_SKIP(PG_Word_Table.series, num));
}

*/	static void Expand_Word_Table(void)
/*
**		Expand the hash table part of the word_table by allocating
**		the next larger table size and rehashing all the words of
**		the current table.  Free the old hash array.
**
***********************************************************************/
{
	REBCNT *hashes;
	REBVAL *word;
	REBINT hash;
	REBCNT size;
	REBINT skip;
	REBCNT n;

	// Allocate a new hash table:
	Expand_Hash(PG_Word_Table.hashes);
	// Debug_Fmt("WORD-TABLE: expanded (%d symbols, %d slots)", PG_Word_Table.series->tail, PG_Word_Table.hashes->tail);

	// Rehash all the symbols:
	word = BLK_SKIP(PG_Word_Table.series, 1);
	hashes = (REBCNT *)PG_Word_Table.hashes->data;
	size = PG_Word_Table.hashes->tail;
	for (n = 1; n < PG_Word_Table.series->tail; n++, word++) {
		hash = Hash_Word(VAL_SYM_NAME(word), -1);
		skip  = (hash & 0x0000FFFF) % size;
		if (skip == 0) skip = 1;
		hash = (hash & 0x00FFFF00) % size;
		while (hashes[hash]) {
			hash += skip;
			if (hash >= (REBINT)size) hash -= size;
		}
		hashes[hash] = n;
	}
}

*/	void Init_Errors(REBVAL *errors)
/*
***********************************************************************/
{
	REBSER *errs;
	REBVAL *val;

	// Create error objects and error type objects:
	*ROOT_ERROBJ = *Get_System(SYS_STANDARD, STD_ERROR);
	errs = Construct_Object(0, VAL_BLK(errors), 0);
	Set_Object(Get_System(SYS_CATALOG, CAT_ERRORS), errs);

	Set_Root_Series(TASK_ERR_TEMPS, Make_Block(3));

	// Create objects for all error types:
	for (val = BLK_SKIP(errs, 1); NOT_END(val); val++) {
		errs = Construct_Object(0, VAL_BLK(val), 0);
		SET_OBJECT(val, errs);
	}

	// Catch top level errors, to provide decent output:
	PUSH_STATE(Top_State, Saved_State);
	if (SET_JUMP(Top_State)) {
		POP_STATE(Top_State, Saved_State);
		DSP++; // Room for return value
		Catch_Error(DS_TOP); // Stores error value here
		Print_Value(DS_TOP, 0, FALSE);
		Crash(RP_NO_CATCH);
	}
	SET_STATE(Top_State, Saved_State);
}

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

*/	RL_API int RL_Start(REBYTE *bin, REBINT len, REBCNT flags)
/*
**	Evaluate the default boot function.
**
**	Returns:
**		Zero on success, otherwise indicates an error occurred.
**	Arguments:
**		bin - optional startup code (compressed), can be null
**		len - length of above bin
**		flags - special flags
**	Notes:
**		This function completes the startup sequence by calling
**		the sys/start function.
**
***********************************************************************/
{
	REBVAL *val;
	REBSER spec = {0};
	REBSER *ser;

	if (bin) {
		spec.data = bin;
		spec.tail = len;
		ser = Decompress(&spec, 0, -1, 10000000, 0);
		if (!ser) return 1;

		val = BLK_SKIP(Sys_Context, SYS_CTX_BOOT_HOST);
		Set_Binary(val, ser);
	}

	return Init_Mezz(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));
}

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

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

*/	static void Trim_Block(REBSER *ser, REBCNT index, REBCNT flags)
/*
**		See Trim_String().
**
***********************************************************************/
{
	REBVAL *blk = BLK_HEAD(ser);
	REBCNT out = index;
	REBCNT end = ser->tail;

	if (flags & AM_TRIM_TAIL) {
		for (; end >= (index+1); end--) {
			if (VAL_TYPE(blk+end-1) > REB_NONE) break;
		}
		Remove_Series(ser, end, ser->tail - end);
		if (!(flags & AM_TRIM_HEAD) || index >= end) return;
	}

	if (flags & AM_TRIM_HEAD) {
		for (; index < end; index++) {
			if (VAL_TYPE(blk+index) > REB_NONE) break;
		}
		Remove_Series(ser, out, index - out);
	}

	if (flags == 0) {
		for (; index < end; index++) {
			if (VAL_TYPE(blk+index) > REB_NONE) {
				*BLK_SKIP(ser, out) = blk[index];
				out++;
			}
		}
		Remove_Series(ser, out, end - out);
	}
}

*/	REBINT PD_Frame(REBPVS *pvs)
/*
**		pvs->value points to the first value in frame (SELF).
**
***********************************************************************/
{
	REBCNT sym;
	REBCNT s;
	REBVAL *word;
	REBVAL *val;

	if (IS_WORD(pvs->select)) {
		sym = VAL_WORD_SYM(pvs->select);
		s = SYMBOL_TO_CANON(sym);
		word = BLK_SKIP(VAL_FRM_WORDS(pvs->value), 1);
		for (val = pvs->value + 1; NOT_END(val); val++, word++) {
			if (sym == VAL_BIND_SYM(word) || s == VAL_BIND_CANON(word)) {
				if (VAL_GET_OPT(word, OPTS_HIDE)) break;
				if (VAL_PROTECTED(word)) Trap1(RE_LOCKED_WORD, word);
				pvs->value = val;
				return PE_SET;
			}
		}
	}
	return PE_BAD_SELECT;
}

*/	void *Use_Port_State(REBSER *port, REBCNT device, REBCNT size)
/*
**		Use private state area in a port. Create if necessary.
**		The size is that of a binary structure used by
**		the port for storing internal information.
**
***********************************************************************/
{
	REBVAL *state = BLK_SKIP(port, STD_PORT_STATE);

	// If state is not a binary structure, create it:
	if (!IS_BINARY(state)) {
		REBSER *data = Make_Binary(size);
		REBREQ *req = (REBREQ*)STR_HEAD(data);
		req->clen = size;
		CLEAR(STR_HEAD(data), size);
		//data->tail = size; // makes it easier for ACCEPT to clone the port
		SET_FLAG(req->flags, RRF_ALLOC); // not on stack
		req->port = port;
		req->device = device;
		Val_Init_Binary(state, data);
	}

	return (void *)VAL_BIN(state);
}

*/	REBSER *Check_Func_Spec(REBSER *block)
/*
**		Check function spec of the form:
**
**		["description" arg "notes" [type! type2! ...] /ref ...]
**
**		Throw an error for invalid values.
**
***********************************************************************/
{
	REBVAL *blk;
	REBSER *words;
	REBINT n = 0;
	REBVAL *value;

	blk = BLK_HEAD(block);
	words = Collect_Frame(BIND_ALL | BIND_NO_DUP | BIND_NO_SELF, 0, blk);

	// !!! needs more checks
	for (; NOT_END(blk); blk++) {
		switch (VAL_TYPE(blk)) {
		case REB_BLOCK:
			// Skip the SPEC block as an arg. Use other blocks as datatypes:
			if (n > 0) Make_Typeset(VAL_BLK(blk), BLK_SKIP(words, n), 0);
			break;
		case REB_STRING:
		case REB_INTEGER:	// special case used by datatype test actions
			break;
		case REB_WORD:
		case REB_GET_WORD:
		case REB_LIT_WORD:
			n++;
			break;
		case REB_REFINEMENT:
			// Refinement only allows logic! and none! for its datatype:
			n++;
			value = BLK_SKIP(words, n);
			VAL_TYPESET(value) = (TYPESET(REB_LOGIC) | TYPESET(REB_NONE));
			break;
		case REB_SET_WORD:
		default:
			Trap1_DEAD_END(RE_BAD_FUNC_DEF, blk);
		}
	}

	return words; //Create_Frame(words, 0);
}

*/	void Do_Routine(REBVAL *routine)
/*
 */
{
	//RL_Print("%s, %d\n", __func__, __LINE__);
	REBSER *args = Copy_Values(BLK_SKIP(DS_Series, DS_ARG_BASE + 1), SERIES_TAIL(VAL_FUNC_ARGS(routine)) - 1);
	Call_Routine(routine, args, DS_OUT);
}