From 7efd949304bb6b91ffde055e220444c1d1efff68 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Thu, 18 Oct 2018 07:55:28 +0200 Subject: [PATCH] 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. --- scaffold/mini-mes.c | 24 +++++++ src/hash.c | 149 +++++++++++++++++++++++++++++++++++--------- src/mes.c | 32 +++++++++- src/module.c | 19 +++--- 4 files changed, 181 insertions(+), 43 deletions(-) diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c index 9da6de98..b8909658 100644 --- a/scaffold/mini-mes.c +++ b/scaffold/mini-mes.c @@ -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, "",0}; +struct scm scm_symbol_record_type = {TSYMBOL, "",0}; +struct scm scm_symbol_module = {TSYMBOL, "",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) { diff --git a/src/hash.c b/src/hash.c index 6ddae79a..f2dee09c 100644 --- a/src/hash.c +++ b/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 (""); - SCM record_type = record_type_name; // FIXME - SCM hashq_type_name = cstring_to_symbol (""); + 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 (""); - SCM record_type_name = cstring_to_symbol (""); - //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); } diff --git a/src/mes.c b/src/mes.c index f4f8686d..625d432a 100644 --- a/src/mes.c +++ b/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, "",0}; +struct scm scm_symbol_record_type = {TSYMBOL, "",0}; +struct scm scm_symbol_module = {TSYMBOL, "",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); diff --git a/src/module.c b/src/module.c index c0b73740..484b121b 100644 --- a/src/module.c +++ b/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 (""); - SCM record_type = record_type_name; // FIXME - SCM module_type_name = cstring_to_symbol (""); + 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 (""); - // 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 (""); - 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; }