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

Comparing cvsroot/microscheme/scheme.c (file contents):
Revision 1.29 by root, Sat Nov 28 10:31:06 2015 UTC vs.
Revision 1.32 by root, Sat Nov 28 10:56:45 2015 UTC

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
2925 for (y = car (x); y != NIL; y = cdr (y)) 2936 for (y = car (x); y != NIL; y = cdr (y))
2926 if (caar (y) == hdl) 2937 if (caar (y) == hdl)
2927 break; 2938 break;
2928 2939
2929 if (y != NIL) 2940 if (y != NIL)
2941 return car (y);
2930 break; 2942 break;
2931 2943
2932 if (!all) 2944 if (!all)
2933 return NIL; 2945 break;
2934 } 2946 }
2935
2936 if (x != NIL)
2937 return car (y);
2938 2947
2939 return NIL; 2948 return NIL;
2940} 2949}
2941 2950
2942#endif /* USE_ALIST_ENV else */ 2951#endif /* USE_ALIST_ENV else */

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines