ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/microscheme/scheme.c
(Generate patch)

Comparing microscheme/scheme.c (file contents):
Revision 1.30 by root, Sat Nov 28 10:31:40 2015 UTC vs.
Revision 1.31 by root, Sat Nov 28 10:54:41 2015 UTC

… …
391} 391}
392 392
393INTERFACE char * 393INTERFACE char *
394symname (pointer p) 394symname (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
400SCHEME_EXPORT int 400SCHEME_EXPORT int
401hasprop (pointer p) 401hasprop (pointer p)
… …
1095static pointer 1095static pointer
1096oblist_add_by_name (SCHEME_P_ const char *name) 1096oblist_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 */
1171static pointer 1171static pointer
1172oblist_add_by_name (SCHEME_P_ const char *name) 1172oblist_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
1183static pointer 1181static 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
2856static uint32_t
2857sym_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
2858ecb_inline void 2871ecb_inline void
2859new_slot_spec_in_env (SCHEME_P_ pointer env, pointer variable, pointer value) 2872new_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
2873static pointer 2885static pointer
2874find_slot_in_env (SCHEME_P_ pointer env, pointer hdl, int all) 2886find_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

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines