152 |
|
|
153 |
#define EXTEND_ENV SCM_EXTEND_ENV |
#define EXTEND_ENV SCM_EXTEND_ENV |
154 |
|
|
|
#ifdef MEMOIZE_LOCALS |
|
|
|
|
155 |
SCM * |
SCM * |
156 |
scm_ilookup (SCM iloc, SCM env) |
scm_ilookup (SCM iloc, SCM env) |
157 |
{ |
{ |
166 |
return SCM_CDRLOC (er); |
return SCM_CDRLOC (er); |
167 |
return SCM_CARLOC (SCM_CDR (er)); |
return SCM_CARLOC (SCM_CDR (er)); |
168 |
} |
} |
|
#endif |
|
169 |
|
|
170 |
#ifdef USE_THREADS |
#ifdef USE_THREADS |
171 |
|
|
256 |
{ |
{ |
257 |
SCM env = genv; |
SCM env = genv; |
258 |
register SCM *al, fl, var = SCM_CAR (vloc); |
register SCM *al, fl, var = SCM_CAR (vloc); |
|
#ifdef MEMOIZE_LOCALS |
|
259 |
register SCM iloc = SCM_ILOC00; |
register SCM iloc = SCM_ILOC00; |
|
#endif |
|
260 |
for (; SCM_NIMP (env); env = SCM_CDR (env)) |
for (; SCM_NIMP (env); env = SCM_CDR (env)) |
261 |
{ |
{ |
262 |
if (!SCM_CONSP (SCM_CAR (env))) |
if (!SCM_CONSP (SCM_CAR (env))) |
268 |
{ |
{ |
269 |
if (SCM_EQ_P (fl, var)) |
if (SCM_EQ_P (fl, var)) |
270 |
{ |
{ |
|
#ifdef MEMOIZE_LOCALS |
|
271 |
#ifdef USE_THREADS |
#ifdef USE_THREADS |
272 |
if (! SCM_EQ_P (SCM_CAR (vloc), var)) |
if (! SCM_EQ_P (SCM_CAR (vloc), var)) |
273 |
goto race; |
goto race; |
274 |
#endif |
#endif |
275 |
SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (iloc) + SCM_ICDR); |
SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (iloc) + SCM_ICDR); |
|
#endif |
|
276 |
return SCM_CDRLOC (*al); |
return SCM_CDRLOC (*al); |
277 |
} |
} |
278 |
else |
else |
281 |
al = SCM_CDRLOC (*al); |
al = SCM_CDRLOC (*al); |
282 |
if (SCM_EQ_P (SCM_CAR (fl), var)) |
if (SCM_EQ_P (SCM_CAR (fl), var)) |
283 |
{ |
{ |
|
#ifdef MEMOIZE_LOCALS |
|
284 |
#ifndef SCM_RECKLESS /* letrec inits to SCM_UNDEFINED */ |
#ifndef SCM_RECKLESS /* letrec inits to SCM_UNDEFINED */ |
285 |
if (SCM_UNBNDP (SCM_CAR (*al))) |
if (SCM_UNBNDP (SCM_CAR (*al))) |
286 |
{ |
{ |
293 |
goto race; |
goto race; |
294 |
#endif |
#endif |
295 |
SCM_SETCAR (vloc, iloc); |
SCM_SETCAR (vloc, iloc); |
|
#endif |
|
296 |
return SCM_CARLOC (*al); |
return SCM_CARLOC (*al); |
297 |
} |
} |
|
#ifdef MEMOIZE_LOCALS |
|
298 |
iloc = SCM_PACK (SCM_UNPACK (iloc) + SCM_IDINC); |
iloc = SCM_PACK (SCM_UNPACK (iloc) + SCM_IDINC); |
|
#endif |
|
299 |
} |
} |
|
#ifdef MEMOIZE_LOCALS |
|
300 |
iloc = SCM_PACK ((~SCM_IDSTMSK) & (SCM_UNPACK(iloc) + SCM_IFRINC)); |
iloc = SCM_PACK ((~SCM_IDSTMSK) & (SCM_UNPACK(iloc) + SCM_IFRINC)); |
|
#endif |
|
301 |
} |
} |
302 |
{ |
{ |
303 |
SCM top_thunk, real_var; |
SCM top_thunk, real_var; |
347 |
var = SCM_CAR (vloc); |
var = SCM_CAR (vloc); |
348 |
if (SCM_VARIABLEP (var)) |
if (SCM_VARIABLEP (var)) |
349 |
return SCM_VARIABLE_LOC (var); |
return SCM_VARIABLE_LOC (var); |
|
#ifdef MEMOIZE_LOCALS |
|
350 |
if (SCM_ITAG7 (var) == SCM_ITAG7 (SCM_ILOC00)) |
if (SCM_ITAG7 (var) == SCM_ITAG7 (SCM_ILOC00)) |
351 |
return scm_ilookup (var, genv); |
return scm_ilookup (var, genv); |
|
#endif |
|
352 |
/* We can't cope with anything else than variables and ilocs. When |
/* We can't cope with anything else than variables and ilocs. When |
353 |
a special form has been memoized (i.e. `let' into `#@let') we |
a special form has been memoized (i.e. `let' into `#@let') we |
354 |
return NULL and expect the calling function to do the right |
return NULL and expect the calling function to do the right |
393 |
sym = sym_three_question_marks; |
sym = sym_three_question_marks; |
394 |
SCM_SETCAR (form, sym); |
SCM_SETCAR (form, sym); |
395 |
} |
} |
|
#ifdef MEMOIZE_LOCALS |
|
396 |
else if (SCM_ILOCP (c)) |
else if (SCM_ILOCP (c)) |
397 |
{ |
{ |
398 |
unsigned long int ir; |
unsigned long int ir; |
404 |
env = SCM_CDR (env); |
env = SCM_CDR (env); |
405 |
SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env)); |
SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env)); |
406 |
} |
} |
|
#endif |
|
407 |
return form; |
return form; |
408 |
} |
} |
409 |
} |
} |
2296 |
{ |
{ |
2297 |
SCM *location; |
SCM *location; |
2298 |
SCM variable = SCM_CAR (x); |
SCM variable = SCM_CAR (x); |
|
#ifdef MEMOIZE_LOCALS |
|
2299 |
if (SCM_ILOCP (variable)) |
if (SCM_ILOCP (variable)) |
2300 |
location = scm_ilookup (variable, env); |
location = scm_ilookup (variable, env); |
2301 |
else |
else |
|
#endif |
|
2302 |
if (SCM_VARIABLEP (variable)) |
if (SCM_VARIABLEP (variable)) |
2303 |
location = SCM_VARIABLE_LOC (variable); |
location = SCM_VARIABLE_LOC (variable); |
2304 |
else /* (SCM_SYMBOLP (variable)) is known to be true */ |
else /* (SCM_SYMBOLP (variable)) is known to be true */ |
2694 |
case scm_tc7_variable: |
case scm_tc7_variable: |
2695 |
RETURN (SCM_VARIABLE_REF(x)); |
RETURN (SCM_VARIABLE_REF(x)); |
2696 |
|
|
|
#ifdef MEMOIZE_LOCALS |
|
2697 |
case SCM_BIT8(SCM_ILOC00): |
case SCM_BIT8(SCM_ILOC00): |
2698 |
proc = *scm_ilookup (SCM_CAR (x), env); |
proc = *scm_ilookup (SCM_CAR (x), env); |
2699 |
SCM_ASRTGO (SCM_NIMP (proc), badfun); |
SCM_ASRTGO (SCM_NIMP (proc), badfun); |
2703 |
#endif |
#endif |
2704 |
#endif |
#endif |
2705 |
break; |
break; |
|
#endif /* ifdef MEMOIZE_LOCALS */ |
|
2706 |
|
|
2707 |
case scm_tcs_cons_nimcar: |
case scm_tcs_cons_nimcar: |
2708 |
if (SCM_SYMBOLP (SCM_CAR (x))) |
if (SCM_SYMBOLP (SCM_CAR (x))) |