core: Add hashq_get_handle, hash, hash_ref, hash_set_x.
* src/mes.c (scm_symbol_hashq_table, scm_symbol_record_type, scm_symbol_module, scm_symbol_buckets, scm_symbol_size): New symbols. Update users. * src/hash.c (hash_list_of_char): Rename from hashq_. Respect size, update callers. (hashq_, hash_ hash, hashq_get_handle, hash_ref, hash_set_x_, hash_set_x): New function. (hashq_ref): Do not return handle. Update callers.
This commit is contained in:
Jan Nieuwenhuizen
parent
67046e1b00
commit
7efd949304
|
|
@ -134,6 +134,12 @@ struct scm scm_symbol_wrong_number_of_args = {TSYMBOL, "wrong-number-of-args",0}
|
|||
struct scm scm_symbol_wrong_type_arg = {TSYMBOL, "wrong-type-arg",0};
|
||||
struct scm scm_symbol_unbound_variable = {TSYMBOL, "unbound-variable",0};
|
||||
|
||||
struct scm scm_symbol_hashq_table = {TSYMBOL, "<hashq-table>",0};
|
||||
struct scm scm_symbol_record_type = {TSYMBOL, "<record-type>",0};
|
||||
struct scm scm_symbol_module = {TSYMBOL, "<module>",0};
|
||||
struct scm scm_symbol_buckets = {TSYMBOL, "buckets",0};
|
||||
struct scm scm_symbol_size = {TSYMBOL, "size",0};
|
||||
|
||||
struct scm scm_symbol_argv = {TSYMBOL, "%argv",0};
|
||||
struct scm scm_symbol_mes_prefix = {TSYMBOL, "%prefix",0};
|
||||
struct scm scm_symbol_mes_version = {TSYMBOL, "%version",0};
|
||||
|
|
@ -646,6 +652,24 @@ assq (SCM x, SCM a)
|
|||
return a != cell_nil ? CAR (a) : cell_f;
|
||||
}
|
||||
|
||||
SCM
|
||||
assoc_string (SCM x, SCM a) ///(internal))
|
||||
{
|
||||
while (a != cell_nil && list_of_char_equal_p (STRING (x), STRING (CAAR (a))) == cell_f)
|
||||
a = CDR (a);
|
||||
return a != cell_nil ? CAR (a) : cell_f;
|
||||
}
|
||||
|
||||
SCM
|
||||
assoc (SCM x, SCM a)
|
||||
{
|
||||
if (TYPE (x) == TSTRING)
|
||||
return assoc_string (x, a);
|
||||
while (a != cell_nil && equal2_p (x, CAAR (a)) == cell_f)
|
||||
a = CDR (a);
|
||||
return a != cell_nil ? CAR (a) : cell_f;
|
||||
}
|
||||
|
||||
SCM
|
||||
set_car_x (SCM x, SCM e)
|
||||
{
|
||||
|
|
|
|||
149
src/hash.c
149
src/hash.c
|
|
@ -23,35 +23,53 @@ SCM vector_ref_ (SCM x, long i);
|
|||
SCM vector_set_x_ (SCM x, long i, SCM e);
|
||||
|
||||
int
|
||||
char_hash (int c)
|
||||
hash_list_of_char (SCM lst, long size)
|
||||
{
|
||||
if (c >= 'a' && c <= 'z')
|
||||
return c - 'a';
|
||||
return 27;
|
||||
int hash = VALUE (CAR (lst)) * 37;
|
||||
if (TYPE (CDR (lst)) == TPAIR && TYPE (CADR (lst)) == TCHAR)
|
||||
hash = hash + VALUE (CADR (lst)) * 43;
|
||||
assert (size);
|
||||
hash = hash % size;
|
||||
return hash;
|
||||
}
|
||||
|
||||
int
|
||||
hashq_ (SCM x, long size)
|
||||
{
|
||||
int hash = char_hash (VALUE (CAR (STRING (x)))) * 27;
|
||||
if (TYPE (CDR (STRING (x))) == TPAIR)
|
||||
hash = hash + char_hash (VALUE (CADR (STRING (x))));
|
||||
else
|
||||
hash = hash + char_hash (0);
|
||||
assert (hash <= 756);
|
||||
return hash;
|
||||
if (TYPE (x) == TSPECIAL
|
||||
|| TYPE (x) == TSYMBOL)
|
||||
return hash_list_of_char (STRING (x), size); // FIXME: hash x directly
|
||||
error (cell_symbol_system_error, cons (MAKE_STRING (cstring_to_list ("hashq_: not a symbol")), x));
|
||||
}
|
||||
|
||||
int
|
||||
hashq (SCM x, SCM size)
|
||||
hash_ (SCM x, long size)
|
||||
{
|
||||
return hashq_ (x, VALUE (size));
|
||||
if (TYPE (x) == TSTRING)
|
||||
return hash_list_of_char (STRING (x), size);
|
||||
assert (0);
|
||||
return hashq_ (x, size);
|
||||
}
|
||||
|
||||
SCM
|
||||
hashq_ref (SCM table, SCM key, SCM dflt)
|
||||
hashq (SCM x, SCM size)
|
||||
{
|
||||
unsigned hash = hashq_ (key, 0);
|
||||
assert (0);
|
||||
return MAKE_NUMBER (hashq_ (x, VALUE (size)));
|
||||
}
|
||||
|
||||
SCM
|
||||
hash (SCM x, SCM size)
|
||||
{
|
||||
assert (0);
|
||||
return MAKE_NUMBER (hash_ (x, VALUE (size)));
|
||||
}
|
||||
|
||||
SCM
|
||||
hashq_get_handle (SCM table, SCM key, SCM dflt)
|
||||
{
|
||||
long size = VALUE (struct_ref_ (table, 3));
|
||||
unsigned hash = hashq_ (key, size);
|
||||
SCM buckets = struct_ref_ (table, 4);
|
||||
SCM bucket = vector_ref_ (buckets, hash);
|
||||
SCM x = cell_f;
|
||||
|
|
@ -63,9 +81,50 @@ hashq_ref (SCM table, SCM key, SCM dflt)
|
|||
}
|
||||
|
||||
SCM
|
||||
hashq_set_x (SCM table, SCM key, SCM value)
|
||||
hashq_ref (SCM table, SCM key, SCM dflt)
|
||||
{
|
||||
#if defined (INLINE)
|
||||
SCM x = hashq_get_handle (table, key, dflt);
|
||||
#else
|
||||
long size = VALUE (struct_ref_ (table, 3));
|
||||
unsigned hash = hashq_ (key, size);
|
||||
SCM buckets = struct_ref_ (table, 4);
|
||||
SCM bucket = vector_ref_ (buckets, hash);
|
||||
SCM x = cell_f;
|
||||
if (TYPE (dflt) == TPAIR)
|
||||
x = CAR (dflt);
|
||||
if (TYPE (bucket) == TPAIR)
|
||||
x = assq (key, bucket);
|
||||
#endif
|
||||
if (x != cell_f)
|
||||
x = CDR (x);
|
||||
return x;
|
||||
}
|
||||
|
||||
SCM
|
||||
hash_ref (SCM table, SCM key, SCM dflt)
|
||||
{
|
||||
long size = VALUE (struct_ref_ (table, 3));
|
||||
unsigned hash = hash_ (key, size);
|
||||
SCM buckets = struct_ref_ (table, 4);
|
||||
SCM bucket = vector_ref_ (buckets, hash);
|
||||
SCM x = cell_f;
|
||||
if (TYPE (dflt) == TPAIR)
|
||||
x = CAR (dflt);
|
||||
if (TYPE (bucket) == TPAIR)
|
||||
{
|
||||
x = assoc (key, bucket);
|
||||
if (x != cell_f)
|
||||
x = CDR (x);
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
||||
#if defined (INLINE)
|
||||
#error INLINE
|
||||
SCM
|
||||
hash_set_x_ (SCM table, unsigned hash, SCM key, SCM value)
|
||||
{
|
||||
unsigned hash = hashq_ (key, 0);
|
||||
SCM buckets = struct_ref_ (table, 4);
|
||||
SCM bucket = vector_ref_ (buckets, hash);
|
||||
if (TYPE (bucket) != TPAIR)
|
||||
|
|
@ -74,6 +133,43 @@ hashq_set_x (SCM table, SCM key, SCM value)
|
|||
vector_set_x_ (buckets, hash, bucket);
|
||||
return value;
|
||||
}
|
||||
#endif
|
||||
|
||||
SCM
|
||||
hashq_set_x (SCM table, SCM key, SCM value)
|
||||
{
|
||||
long size = VALUE (struct_ref_ (table, 3));
|
||||
unsigned hash = hashq_ (key, size);
|
||||
#if defined (INLINE)
|
||||
return hash_set_x_ (table, hash, key, value);
|
||||
#else
|
||||
SCM buckets = struct_ref_ (table, 4);
|
||||
SCM bucket = vector_ref_ (buckets, hash);
|
||||
if (TYPE (bucket) != TPAIR)
|
||||
bucket = cell_nil;
|
||||
bucket = acons (key, value, bucket);
|
||||
vector_set_x_ (buckets, hash, bucket);
|
||||
return value;
|
||||
#endif
|
||||
}
|
||||
|
||||
SCM
|
||||
hash_set_x (SCM table, SCM key, SCM value)
|
||||
{
|
||||
long size = VALUE (struct_ref_ (table, 3));
|
||||
unsigned hash = hash_ (key, size);
|
||||
#if defined (INLINE)
|
||||
return hash_set_x_ (table, hash, key, value);
|
||||
#else
|
||||
SCM buckets = struct_ref_ (table, 4);
|
||||
SCM bucket = vector_ref_ (buckets, hash);
|
||||
if (TYPE (bucket) != TPAIR)
|
||||
bucket = cell_nil;
|
||||
bucket = acons (key, value, bucket);
|
||||
vector_set_x_ (buckets, hash, bucket);
|
||||
return value;
|
||||
#endif
|
||||
}
|
||||
|
||||
SCM
|
||||
hash_table_printer (SCM table)
|
||||
|
|
@ -90,7 +186,7 @@ hash_table_printer (SCM table)
|
|||
fdputc ('[', g_stdout);
|
||||
while (TYPE (e) == TPAIR)
|
||||
{
|
||||
display_ (CAAR (e));
|
||||
write_ (CAAR (e));
|
||||
e = CDR (e);
|
||||
if (TYPE (e) == TPAIR)
|
||||
fdputc (' ', g_stdout);
|
||||
|
|
@ -104,14 +200,12 @@ hash_table_printer (SCM table)
|
|||
SCM
|
||||
make_hashq_type () ///((internal))
|
||||
{
|
||||
SCM record_type_name = cstring_to_symbol ("<record-type>");
|
||||
SCM record_type = record_type_name; // FIXME
|
||||
SCM hashq_type_name = cstring_to_symbol ("<hashq-table>");
|
||||
SCM record_type = cell_symbol_record_type; // FIXME
|
||||
SCM fields = cell_nil;
|
||||
fields = cons (cstring_to_symbol ("buckets"), fields);
|
||||
fields = cons (cstring_to_symbol ("size"), fields);
|
||||
fields = cons (cell_symbol_buckets, fields);
|
||||
fields = cons (cell_symbol_size, fields);
|
||||
fields = cons (fields, cell_nil);
|
||||
fields = cons (hashq_type_name, fields);
|
||||
fields = cons (cell_symbol_hashq_table, fields);
|
||||
return make_struct (record_type, fields, cell_unspecified);
|
||||
}
|
||||
|
||||
|
|
@ -119,17 +213,14 @@ SCM
|
|||
make_hash_table_ (long size)
|
||||
{
|
||||
if (!size)
|
||||
size = 30 * 27;
|
||||
SCM hashq_type_name = cstring_to_symbol ("<hashq-table>");
|
||||
SCM record_type_name = cstring_to_symbol ("<record-type>");
|
||||
//SCM hashq_type = hashq_type_name; // FIXME
|
||||
size = 100;
|
||||
SCM hashq_type = make_hashq_type ();
|
||||
|
||||
SCM buckets = make_vector__ (size);
|
||||
SCM values = cell_nil;
|
||||
values = cons (buckets, values);
|
||||
values = cons (MAKE_NUMBER (size), values);
|
||||
values = cons (hashq_type_name, values);
|
||||
values = cons (cell_symbol_hashq_table, values);
|
||||
return make_struct (hashq_type, values, cell_hash_table_printer);
|
||||
}
|
||||
|
||||
|
|
|
|||
32
src/mes.c
32
src/mes.c
|
|
@ -28,7 +28,7 @@
|
|||
#if POSIX
|
||||
long ARENA_SIZE = 100000000;
|
||||
#else
|
||||
long ARENA_SIZE = 200000; // 32b: 2MiB, 64b: 4 MiB
|
||||
long ARENA_SIZE = 300000; // 32b: 3MiB, 64b: 6 MiB
|
||||
#endif
|
||||
long MAX_ARENA_SIZE = 100000000;
|
||||
long STACK_SIZE = 20000;
|
||||
|
|
@ -200,6 +200,12 @@ struct scm scm_symbol_wrong_number_of_args = {TSYMBOL, "wrong-number-of-args",0}
|
|||
struct scm scm_symbol_wrong_type_arg = {TSYMBOL, "wrong-type-arg",0};
|
||||
struct scm scm_symbol_unbound_variable = {TSYMBOL, "unbound-variable",0};
|
||||
|
||||
struct scm scm_symbol_hashq_table = {TSYMBOL, "<hashq-table>",0};
|
||||
struct scm scm_symbol_record_type = {TSYMBOL, "<record-type>",0};
|
||||
struct scm scm_symbol_module = {TSYMBOL, "<module>",0};
|
||||
struct scm scm_symbol_buckets = {TSYMBOL, "buckets",0};
|
||||
struct scm scm_symbol_size = {TSYMBOL, "size",0};
|
||||
|
||||
struct scm scm_symbol_argv = {TSYMBOL, "%argv",0};
|
||||
struct scm scm_symbol_mes_prefix = {TSYMBOL, "%prefix",0};
|
||||
struct scm scm_symbol_mes_version = {TSYMBOL, "%version",0};
|
||||
|
|
@ -930,7 +936,9 @@ make_variable_ (SCM var) ///((internal))
|
|||
SCM
|
||||
macro_ref (SCM table, SCM name) ///((internal))
|
||||
{
|
||||
return hashq_ref (table, name, cell_nil);
|
||||
if (TYPE (name) == TSYMBOL)
|
||||
return hashq_get_handle (table, name, cell_nil);
|
||||
return cell_f;
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
@ -1836,6 +1844,21 @@ g_cells[cell_symbol_wrong_type_arg] = scm_symbol_wrong_type_arg;
|
|||
g_free++;
|
||||
g_cells[cell_symbol_unbound_variable] = scm_symbol_unbound_variable;
|
||||
|
||||
g_free++;
|
||||
g_cells[cell_symbol_hashq_table] = scm_symbol_hashq_table;
|
||||
|
||||
g_free++;
|
||||
g_cells[cell_symbol_record_type] = scm_symbol_record_type;
|
||||
|
||||
g_free++;
|
||||
g_cells[cell_symbol_module] = scm_symbol_module;
|
||||
|
||||
g_free++;
|
||||
g_cells[cell_symbol_buckets] = scm_symbol_buckets;
|
||||
|
||||
g_free++;
|
||||
g_cells[cell_symbol_size] = scm_symbol_size;
|
||||
|
||||
g_free++;
|
||||
g_cells[cell_symbol_argv] = scm_symbol_argv;
|
||||
|
||||
|
|
@ -2034,6 +2057,11 @@ g_cells[cell_symbol_system_error].car = cstring_to_list (scm_symbol_system_error
|
|||
g_cells[cell_symbol_wrong_number_of_args].car = cstring_to_list (scm_symbol_wrong_number_of_args.name);
|
||||
g_cells[cell_symbol_wrong_type_arg].car = cstring_to_list (scm_symbol_wrong_type_arg.name);
|
||||
g_cells[cell_symbol_unbound_variable].car = cstring_to_list (scm_symbol_unbound_variable.name);
|
||||
g_cells[cell_symbol_hashq_table].car = cstring_to_list (scm_symbol_hashq_table.name);
|
||||
g_cells[cell_symbol_record_type].car = cstring_to_list (scm_symbol_record_type.name);
|
||||
g_cells[cell_symbol_module].car = cstring_to_list (scm_symbol_module.name);
|
||||
g_cells[cell_symbol_buckets].car = cstring_to_list (scm_symbol_buckets.name);
|
||||
g_cells[cell_symbol_size].car = cstring_to_list (scm_symbol_size.name);
|
||||
g_cells[cell_symbol_argv].car = cstring_to_list (scm_symbol_argv.name);
|
||||
g_cells[cell_symbol_mes_prefix].car = cstring_to_list (scm_symbol_mes_prefix.name);
|
||||
g_cells[cell_symbol_mes_version].car = cstring_to_list (scm_symbol_mes_version.name);
|
||||
|
|
|
|||
19
src/module.c
19
src/module.c
|
|
@ -24,29 +24,24 @@ SCM struct_set_x_ (SCM x, long i, SCM e);
|
|||
SCM
|
||||
make_module_type () ///(internal))
|
||||
{
|
||||
SCM record_type_name = cstring_to_symbol ("<record-type>");
|
||||
SCM record_type = record_type_name; // FIXME
|
||||
SCM module_type_name = cstring_to_symbol ("<module>");
|
||||
SCM record_type = cell_symbol_record_type; // FIXME
|
||||
SCM fields = cell_nil;
|
||||
fields = cons (cstring_to_symbol ("globals"), fields);
|
||||
fields = cons (cstring_to_symbol ("locals"), fields);
|
||||
fields = cons (cstring_to_symbol ("name"), fields);
|
||||
fields = cons (fields, cell_nil);
|
||||
fields = cons (module_type_name, fields);
|
||||
fields = cons (cell_symbol_module, fields);
|
||||
return make_struct (record_type, fields, cell_unspecified);
|
||||
}
|
||||
|
||||
SCM
|
||||
make_initial_module (SCM a) ///((internal))
|
||||
{
|
||||
SCM module_type_name = cstring_to_symbol ("<module>");
|
||||
// SCM module_type = module_type_name; //FIXME
|
||||
SCM module_type = make_module_type ();
|
||||
a = acons (module_type_name, module_type, a);
|
||||
a = acons (cell_symbol_module, module_type, a);
|
||||
|
||||
SCM hashq_type = make_hashq_type ();
|
||||
SCM hashq_type_name = cstring_to_symbol ("<hashq-table>");
|
||||
a = acons (hashq_type_name, hashq_type, a);
|
||||
a = acons (cell_symbol_hashq_table, hashq_type, a);
|
||||
|
||||
SCM name = cons (cstring_to_symbol ("boot"), cell_nil);
|
||||
SCM globals = make_hash_table_ (0);
|
||||
|
|
@ -56,7 +51,7 @@ make_initial_module (SCM a) ///((internal))
|
|||
values = cons (globals, values);
|
||||
values = cons (locals, values);
|
||||
values = cons (name, values);
|
||||
values = cons (module_type_name, values);
|
||||
values = cons (cell_symbol_module, values);
|
||||
SCM module = make_struct (module_type, values, cell_module_printer);
|
||||
r0 = cell_nil;
|
||||
r0 = cons (CADR (a), r0);
|
||||
|
|
@ -66,7 +61,7 @@ make_initial_module (SCM a) ///((internal))
|
|||
{
|
||||
if (g_debug > 3)
|
||||
{
|
||||
eputs ("entry="); display_error_ (CAR (a)); eputs ("\n");
|
||||
eputs ("entry="); write_error_ (CAR (a)); eputs ("\n");
|
||||
}
|
||||
module_define_x (module, CAAR (a), CDAR (a));
|
||||
a = CDR (a);
|
||||
|
|
@ -98,7 +93,7 @@ module_variable (SCM module, SCM name)
|
|||
{
|
||||
module = m0;
|
||||
SCM globals = struct_ref_ (module, 5);
|
||||
x = hashq_ref (globals, name, cell_f);
|
||||
x = hashq_get_handle (globals, name, cell_f);
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue