… | |
… | |
391 | } |
391 | } |
392 | |
392 | |
393 | INTERFACE char * |
393 | INTERFACE char * |
394 | symname (pointer p) |
394 | symname (pointer p) |
395 | { |
395 | { |
396 | return strvalue (p); |
396 | return strvalue (car (p)); |
397 | } |
397 | } |
398 | |
398 | |
399 | #if USE_PLIST |
399 | #if USE_PLIST |
400 | SCHEME_EXPORT int |
400 | SCHEME_EXPORT int |
401 | hasprop (pointer p) |
401 | hasprop (pointer p) |
… | |
… | |
1095 | static pointer |
1095 | static pointer |
1096 | oblist_add_by_name (SCHEME_P_ const char *name) |
1096 | oblist_add_by_name (SCHEME_P_ const char *name) |
1097 | { |
1097 | { |
1098 | int location; |
1098 | int location; |
1099 | |
1099 | |
1100 | pointer x = mk_string (SCHEME_A_ name); |
1100 | pointer x = immutable_cons (mk_string (SCHEME_A_ name), NIL); |
1101 | set_typeflag (x, T_SYMBOL); |
1101 | set_typeflag (x, T_SYMBOL); |
1102 | setimmutable (car (x)); |
1102 | setimmutable (car (x)); |
1103 | |
1103 | |
1104 | location = hash_fn (name, veclength (SCHEME_V->oblist)); |
1104 | location = hash_fn (name, veclength (SCHEME_V->oblist)); |
1105 | vector_set (SCHEME_V->oblist, location, immutable_cons (x, vector_get (SCHEME_V->oblist, location))); |
1105 | vector_set (SCHEME_V->oblist, location, immutable_cons (x, vector_get (SCHEME_V->oblist, location))); |
… | |
… | |
1169 | |
1169 | |
1170 | /* returns the new symbol */ |
1170 | /* returns the new symbol */ |
1171 | static pointer |
1171 | static pointer |
1172 | oblist_add_by_name (SCHEME_P_ const char *name) |
1172 | oblist_add_by_name (SCHEME_P_ const char *name) |
1173 | { |
1173 | { |
1174 | pointer x; |
1174 | pointer x = mk_string (SCHEME_A_ name); |
1175 | |
|
|
1176 | x = immutable_cons (mk_string (SCHEME_A_ name), NIL); |
|
|
1177 | set_typeflag (x, T_SYMBOL); |
1175 | set_typeflag (x, T_SYMBOL); |
1178 | setimmutable (car (x)); |
1176 | setimmutable (x); |
1179 | SCHEME_V->oblist = immutable_cons (x, SCHEME_V->oblist); |
1177 | SCHEME_V->oblist = immutable_cons (x, SCHEME_V->oblist); |
1180 | return x; |
1178 | return x; |
1181 | } |
1179 | } |
1182 | |
1180 | |
1183 | static pointer |
1181 | static pointer |
… | |
… | |
2853 | |
2851 | |
2854 | SCHEME_V->envir = immutable_cons (new_frame, old_env); |
2852 | SCHEME_V->envir = immutable_cons (new_frame, old_env); |
2855 | setenvironment (SCHEME_V->envir); |
2853 | setenvironment (SCHEME_V->envir); |
2856 | } |
2854 | } |
2857 | |
2855 | |
|
|
2856 | static uint32_t |
|
|
2857 | sym_hash (pointer sym, uint32_t size) |
|
|
2858 | { |
|
|
2859 | uintptr_t ptr = (uintptr_t)sym; |
|
|
2860 | |
|
|
2861 | #if 0 |
|
|
2862 | /* tqable size is prime, so why mix */ |
|
|
2863 | ptr += ptr >> 32; |
|
|
2864 | ptr += ptr >> 16; |
|
|
2865 | ptr += ptr >> 8; |
|
|
2866 | #endif |
|
|
2867 | |
|
|
2868 | return ptr % size; |
|
|
2869 | } |
|
|
2870 | |
2858 | ecb_inline void |
2871 | ecb_inline void |
2859 | new_slot_spec_in_env (SCHEME_P_ pointer env, pointer variable, pointer value) |
2872 | new_slot_spec_in_env (SCHEME_P_ pointer env, pointer variable, pointer value) |
2860 | { |
2873 | { |
2861 | pointer slot = immutable_cons (variable, value); |
2874 | pointer slot = immutable_cons (variable, value); |
2862 | |
2875 | |
2863 | if (is_vector (car (env))) |
2876 | if (is_vector (car (env))) |
2864 | { |
2877 | { |
2865 | int location = hash_fn (symname (variable), veclength (car (env))); |
2878 | int location = sym_hash (variable, veclength (car (env))); |
2866 | |
|
|
2867 | vector_set (car (env), location, immutable_cons (slot, vector_get (car (env), location))); |
2879 | vector_set (car (env), location, immutable_cons (slot, vector_get (car (env), location))); |
2868 | } |
2880 | } |
2869 | else |
2881 | else |
2870 | set_car (env, immutable_cons (slot, car (env))); |
2882 | set_car (env, immutable_cons (slot, car (env))); |
2871 | } |
2883 | } |
2872 | |
2884 | |
2873 | static pointer |
2885 | static pointer |
2874 | find_slot_in_env (SCHEME_P_ pointer env, pointer hdl, int all) |
2886 | find_slot_in_env (SCHEME_P_ pointer env, pointer hdl, int all) |
2875 | { |
2887 | { |
2876 | pointer x, y; |
2888 | pointer x, y; |
2877 | int location; |
|
|
2878 | |
2889 | |
2879 | for (x = env; x != NIL; x = cdr (x)) |
2890 | for (x = env; x != NIL; x = cdr (x)) |
2880 | { |
2891 | { |
2881 | if (is_vector (car (x))) |
2892 | if (is_vector (car (x))) |
2882 | { |
2893 | { |
2883 | location = hash_fn (symname (hdl), veclength (car (x))); |
2894 | int location = sym_hash (hdl, veclength (car (x))); |
2884 | y = vector_get (car (x), location); |
2895 | y = vector_get (car (x), location); |
2885 | } |
2896 | } |
2886 | else |
2897 | else |
2887 | y = car (x); |
2898 | y = car (x); |
2888 | |
2899 | |