*/ REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc)
/*
** Compress a binary (only).
** data
** /part
** length
** /crc32
**
** Note: If the file length is "small", it can't overrun on
** compression too much so we use our magic numbers; otherwise,
** we'll just be safe by a percentage of the file size. This may
** be a bit much, though.
**
***********************************************************************/
{
// NOTE: The use_crc flag is not present in Zlib 1.2.8
// Instead, compress's fifth paramter is the compression level
// It can be a value from 1 to 9, or Z_DEFAULT_COMPRESSION if you
// want it to pick what the library author considers the "worth it"
// tradeoff of time to generally suggest.
uLongf size;
REBSER *output;
REBINT err;
REBYTE out_size[sizeof(REBCNT)];
if (len < 0) Trap_DEAD_END(RE_PAST_END); // !!! better msg needed
size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX);
output = Make_Binary(size);
//DISABLE_GC; // !!! why??
// dest, dest-len, src, src-len, level
err = z_compress2(BIN_HEAD(output), &size, BIN_HEAD(input) + index, len, Z_DEFAULT_COMPRESSION);
if (err) {
REBVAL arg;
if (err == Z_MEM_ERROR) Trap_DEAD_END(RE_NO_MEMORY);
SET_INTEGER(&arg, err);
Trap1_DEAD_END(RE_BAD_PRESS, &arg); //!!!provide error string descriptions
}
SET_STR_END(output, size);
SERIES_TAIL(output) = size;
REBCNT_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end.
Append_Series(output, (REBYTE*)out_size, sizeof(REBCNT));
if (SERIES_AVAIL(output) > 1024) // Is there wasted space?
output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg.
//ENABLE_GC;
return output;
}
*/ static void Scan_Error(REBCNT errnum, SCAN_STATE *ss, REBCNT tkn, REBYTE *arg, REBCNT size, REBVAL *relax)
/*
** Scanner error handler
**
***********************************************************************/
{
ERROR_OBJ *error;
REBSER *errs;
REBYTE *name;
REBYTE *cp;
REBYTE *bp;
REBSER *ser;
REBCNT len = 0;
ss->errors++;
if (PG_Boot_Strs)
name = BOOT_STR(RS_SCAN,tkn);
else
name = (REBYTE*)"boot";
cp = ss->head_line;
while (IS_LEX_SPACE(*cp)) cp++; // skip indentation
bp = cp;
while (NOT_NEWLINE(*cp)) cp++, len++;
//DISABLE_GC;
errs = Make_Error(errnum, 0, 0, 0);
error = (ERROR_OBJ *)FRM_VALUES(errs);
ser = Make_Binary(len + 16);
Append_Bytes(ser, "(line ");
Append_Int(ser, ss->line_count);
Append_Bytes(ser, ") ");
Append_Series(ser, (REBYTE*)bp, len);
Set_String(&error->nearest, ser);
Set_String(&error->arg1, Copy_Bytes(name, -1));
Set_String(&error->arg2, Copy_Bytes(arg, size));
if (relax) {
SET_ERROR(relax, errnum, errs);
//ENABLE_GC;
return;
}
Throw_Error(errs); // ENABLE_GC implied
}
*/ REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc)
/*
** Compress a binary (only).
** data
** /part
** length
** /crc32
**
** Note: If the file length is "small", it can't overrun on
** compression too much so we use our magic numbers; otherwise,
** we'll just be safe by a percentage of the file size. This may
** be a bit much, though.
**
***********************************************************************/
{
REBCNT size;
REBSER *output;
REBINT err;
REBYTE out_size[4];
if (len < 0) Trap0(RE_PAST_END); // !!! better msg needed
size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX);
output = Make_Binary(size);
//DISABLE_GC; // !!! why??
// dest, dest-len, src, src-len, level
err = Z_compress2(BIN_HEAD(output), (uLongf*)&size, BIN_HEAD(input) + index, len, use_crc);
if (err) {
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;
Long_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end.
Append_Series(output, (REBYTE*)out_size, 4);
if (SERIES_AVAIL(output) > 1024) // Is there wasted space?
output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg.
//ENABLE_GC;
return output;
}
*/ REBINT Find_Key(REBSER *series, REBSER *hser, REBVAL *key, REBINT wide, REBCNT cased, REBYTE mode)
/*
** 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
**
***********************************************************************/
{
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) Trap_Type_DEAD_END(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_BIND_SYM(val) ||
(!cased && VAL_WORD_CANON(key) == VAL_BIND_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;
//Debug_Num("hash:", hashes[hash]);
Append_Series(series, (REBYTE*)key, wide);
//Dump_Series(series, "hash");
}
return (mode > 0) ? NOT_FOUND : hash;
}
