167 |
return SCM_CARLOC (SCM_CDR (er)); |
return SCM_CARLOC (SCM_CDR (er)); |
168 |
} |
} |
169 |
|
|
|
#ifdef USE_THREADS |
|
|
|
|
170 |
/* The Lookup Car Race |
/* The Lookup Car Race |
171 |
- by Eva Luator |
- by Eva Luator |
172 |
|
|
240 |
for NULL. I think I've found the only places where this |
for NULL. I think I've found the only places where this |
241 |
applies. */ |
applies. */ |
242 |
|
|
|
#endif /* USE_THREADS */ |
|
|
|
|
243 |
SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable"); |
SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable"); |
244 |
|
|
|
#ifdef USE_THREADS |
|
245 |
static SCM * |
static SCM * |
246 |
scm_lookupcar1 (SCM vloc, SCM genv, int check) |
scm_lookupcar1 (SCM vloc, SCM genv, int check) |
|
#else |
|
|
SCM * |
|
|
scm_lookupcar (SCM vloc, SCM genv, int check) |
|
|
#endif |
|
247 |
{ |
{ |
248 |
SCM env = genv; |
SCM env = genv; |
249 |
register SCM *al, fl, var = SCM_CAR (vloc); |
register SCM *al, fl, var = SCM_CAR (vloc); |
259 |
{ |
{ |
260 |
if (SCM_EQ_P (fl, var)) |
if (SCM_EQ_P (fl, var)) |
261 |
{ |
{ |
|
#ifdef USE_THREADS |
|
262 |
if (! SCM_EQ_P (SCM_CAR (vloc), var)) |
if (! SCM_EQ_P (SCM_CAR (vloc), var)) |
263 |
goto race; |
goto race; |
|
#endif |
|
264 |
SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (iloc) + SCM_ICDR); |
SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (iloc) + SCM_ICDR); |
265 |
return SCM_CDRLOC (*al); |
return SCM_CDRLOC (*al); |
266 |
} |
} |
275 |
env = SCM_EOL; |
env = SCM_EOL; |
276 |
goto errout; |
goto errout; |
277 |
} |
} |
|
#ifdef USE_THREADS |
|
278 |
if (!SCM_EQ_P (SCM_CAR (vloc), var)) |
if (!SCM_EQ_P (SCM_CAR (vloc), var)) |
279 |
goto race; |
goto race; |
|
#endif |
|
280 |
SCM_SETCAR (vloc, iloc); |
SCM_SETCAR (vloc, iloc); |
281 |
return SCM_CARLOC (*al); |
return SCM_CARLOC (*al); |
282 |
} |
} |
320 |
} |
} |
321 |
} |
} |
322 |
|
|
|
#ifdef USE_THREADS |
|
323 |
if (!SCM_EQ_P (SCM_CAR (vloc), var)) |
if (!SCM_EQ_P (SCM_CAR (vloc), var)) |
324 |
{ |
{ |
325 |
/* Some other thread has changed the very cell we are working |
/* Some other thread has changed the very cell we are working |
338 |
the dispatch on the car of the form. */ |
the dispatch on the car of the form. */ |
339 |
return NULL; |
return NULL; |
340 |
} |
} |
|
#endif /* USE_THREADS */ |
|
341 |
|
|
342 |
SCM_SETCAR (vloc, real_var); |
SCM_SETCAR (vloc, real_var); |
343 |
return SCM_VARIABLE_LOC (real_var); |
return SCM_VARIABLE_LOC (real_var); |
344 |
} |
} |
345 |
} |
} |
346 |
|
|
|
#ifdef USE_THREADS |
|
347 |
SCM * |
SCM * |
348 |
scm_lookupcar (SCM vloc, SCM genv, int check) |
scm_lookupcar (SCM vloc, SCM genv, int check) |
349 |
{ |
{ |
352 |
abort (); |
abort (); |
353 |
return loc; |
return loc; |
354 |
} |
} |
|
#endif |
|
355 |
|
|
356 |
#define unmemocar scm_unmemocar |
#define unmemocar scm_unmemocar |
357 |
|
|
1221 |
if (!SCM_SYMBOLP (orig_sym)) |
if (!SCM_SYMBOLP (orig_sym)) |
1222 |
return x; |
return x; |
1223 |
|
|
|
#ifdef USE_THREADS |
|
1224 |
{ |
{ |
1225 |
SCM *proc_ptr = scm_lookupcar1 (x, env, 0); |
SCM *proc_ptr = scm_lookupcar1 (x, env, 0); |
1226 |
if (proc_ptr == NULL) |
if (proc_ptr == NULL) |
1230 |
} |
} |
1231 |
proc = *proc_ptr; |
proc = *proc_ptr; |
1232 |
} |
} |
|
#else |
|
|
proc = *scm_lookupcar (x, env, 0); |
|
|
#endif |
|
1233 |
|
|
1234 |
/* Only handle memoizing macros. `Acros' and `macros' are really |
/* Only handle memoizing macros. `Acros' and `macros' are really |
1235 |
special forms and should not be evaluated here. */ |
special forms and should not be evaluated here. */ |
1671 |
* any stack swaps. |
* any stack swaps. |
1672 |
*/ |
*/ |
1673 |
|
|
|
#ifndef USE_THREADS |
|
|
scm_t_debug_frame *scm_last_debug_frame; |
|
|
#endif |
|
|
|
|
1674 |
/* scm_debug_eframe_size is the number of slots available for pseudo |
/* scm_debug_eframe_size is the number of slots available for pseudo |
1675 |
* stack frames at each real stack frame. |
* stack frames at each real stack frame. |
1676 |
*/ |
*/ |
1925 |
} |
} |
1926 |
} |
} |
1927 |
#endif |
#endif |
|
#if defined (USE_THREADS) || defined (DEVAL) |
|
1928 |
dispatch: |
dispatch: |
|
#endif |
|
1929 |
SCM_TICK; |
SCM_TICK; |
1930 |
switch (SCM_TYP7 (x)) |
switch (SCM_TYP7 (x)) |
1931 |
{ |
{ |
2665 |
if (SCM_SYMBOLP (SCM_CAR (x))) |
if (SCM_SYMBOLP (SCM_CAR (x))) |
2666 |
{ |
{ |
2667 |
SCM orig_sym = SCM_CAR (x); |
SCM orig_sym = SCM_CAR (x); |
|
#ifdef USE_THREADS |
|
2668 |
{ |
{ |
2669 |
SCM *location = scm_lookupcar1 (x, env, 1); |
SCM *location = scm_lookupcar1 (x, env, 1); |
2670 |
if (location == NULL) |
if (location == NULL) |
2674 |
} |
} |
2675 |
proc = *location; |
proc = *location; |
2676 |
} |
} |
|
#else |
|
|
proc = *scm_lookupcar (x, env, 1); |
|
|
#endif |
|
2677 |
|
|
2678 |
if (SCM_IMP (proc)) |
if (SCM_IMP (proc)) |
2679 |
{ |
{ |