mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

* pairs.h, eval.c, eval.h, feature.c, gc.c, list.c, load.c,

Browse source 
ramap.c, symbols.c: Added new selectors SCM_CARLOC and SCM_CDRLOC
for obtaining the address of a car or cdr field.  Motivation:
&SCM_CXR make assumptions about the internal structure of the
SCM_CXR selectors.

* eval.h, eval.c: Added new selector SCM_GLOC_VAL_LOC.
Motivation: see SCM_CXRLOC.

* pairs.h, eval.c, gc.c, init.c, ioext.c, ports.c, ports.h,
srcprop.h, tags.h, throw.c, unif.c: Added new selectors
SCM_SETAND_CAR, SCM_SETAND_CDR, SCM_SETOR_CAR and SCM_SETOR_CDR.
Motivation: Safer use.  Some other macros are defined in terms of
these operations.  If these are defined using the SCM_SETCXR
(<e1>, SCM_CXR (<e1>) <op> <e2>) pattern a complex <e1> will lead
to inefficiency and an <e1> with side-effects could potentially
break.  Also, these particular operations are heavily utilized in
the garbage collector.  In unoptimized code there will be a
measurable speedup.

* alist.c, arbiters.c, continuations.c, debug.c, debug.h, eval.c,
eval.h, feature.c, filesys.c, fports.c, gc.c, gsubr.c, init.c,
ioext.c, kw.c, list.c, load.c, mallocs.c, numbers.c, numbers.h,
pairs.c, pairs.h, ports.c, ports.h, posix.c, procprop.c, procs.c,
procs.h, ramap.c, read.c, root.c, srcprop.c, srcprop.h,
strports.c, symbols.c, tags.h, throw.c, unif.c, variable.c,
vports.c: Cleaned up use of pairs: Don't make any special
assumptions about the internal structure of selectors and
mutators: SCM_CXR (<e1>) = <e2> --> SCM_SETCXR (<e1>, <e2>),
SCM_CXR (<e1>) &= <e2> --> SCM_SETAND_CXR (<e1>, <e2>) etc.
(Among other things, this change makes it easier to build Guile
with certain compilers which have problems with casted lvalues.)
This commit is contained in:
Mikael Djurfeldt 1996-10-20 03:30:16 +00:00
parent e6d34cb65d
commit a23afe534a
1 changed files with 76 additions and 66 deletions
Download patch file Download diff file Expand all files Collapse all files

134
libguile/eval.c
View file

@ -158,8 +158,8 @@ scm_ilookup (iloc, env)
for (ir = SCM_IDIST (iloc); 0 != ir; --ir) for (ir = SCM_IDIST (iloc); 0 != ir; --ir)
er = SCM_CDR (er); er = SCM_CDR (er);
if (SCM_ICDRP (iloc)) if (SCM_ICDRP (iloc))
return &SCM_CDR (er); return SCM_CDRLOC (er);
return &SCM_CAR (SCM_CDR (er)); return SCM_CARLOC (SCM_CDR (er));
} }
#endif #endif
@ -178,20 +178,20 @@ scm_lookupcar (vloc, genv)
{ {
if (SCM_BOOL_T == scm_procedure_p (SCM_CAR (env))) if (SCM_BOOL_T == scm_procedure_p (SCM_CAR (env)))
break; break;
al = &SCM_CAR (env); al = SCM_CARLOC (env);
for (fl = SCM_CAR (*al); SCM_NIMP (fl); fl = SCM_CDR (fl)) for (fl = SCM_CAR (*al); SCM_NIMP (fl); fl = SCM_CDR (fl))
{ {
if (SCM_NCONSP (fl)) if (SCM_NCONSP (fl))
if (fl == var) if (fl == var)
{ {
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
SCM_CAR (vloc) = iloc + SCM_ICDR; SCM_SETCAR (vloc, iloc + SCM_ICDR);
#endif #endif
return &SCM_CDR (*al); return SCM_CDRLOC (*al);
} }
else else
break; break;
al = &SCM_CDR (*al); al = SCM_CDRLOC (*al);
if (SCM_CAR (fl) == var) if (SCM_CAR (fl) == var)
{ {
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
@ -202,9 +202,9 @@ scm_lookupcar (vloc, genv)
goto errout; goto errout;
} }
#endif #endif
SCM_CAR (vloc) = iloc; SCM_SETCAR (vloc, iloc);
#endif #endif
return &SCM_CAR (*al); return SCM_CARLOC (*al);
} }
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
iloc += SCM_IDINC; iloc += SCM_IDINC;
@ -244,11 +244,11 @@ scm_lookupcar (vloc, genv)
SCM_BOOL_F); SCM_BOOL_F);
} }
#endif #endif
SCM_CAR (vloc) = var + 1; SCM_SETCAR (vloc, var + 1);
/* Except wait...what if the var is not a vcell, /* Except wait...what if the var is not a vcell,
* but syntax or something.... * but syntax or something....
*/ */
return &SCM_CDR (var); return SCM_CDRLOC (var);
} }
#define unmemocar scm_unmemocar #define unmemocar scm_unmemocar
@ -267,7 +267,7 @@ scm_unmemocar (form, env)
return form; return form;
c = SCM_CAR (form); c = SCM_CAR (form);
if (1 == (c & 7)) if (1 == (c & 7))
SCM_CAR (form) = SCM_CAR (c - 1); SCM_SETCAR (form, SCM_CAR (c - 1));
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
else if (SCM_ILOCP (c)) else if (SCM_ILOCP (c))
@ -277,7 +277,7 @@ scm_unmemocar (form, env)
env = SCM_CAR (SCM_CAR (env)); env = SCM_CAR (SCM_CAR (env));
for (ir = SCM_IDIST (c); ir != 0; --ir) for (ir = SCM_IDIST (c); ir != 0; --ir)
env = SCM_CDR (env); env = SCM_CDR (env);
SCM_CAR (form) = SCM_ICDRP (c) ? env : SCM_CAR (env); SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env));
} }
#endif #endif
#endif #endif
@ -492,7 +492,7 @@ scm_m_cond (xorig, env)
if (scm_i_else == SCM_CAR (arg1)) if (scm_i_else == SCM_CAR (arg1))
{ {
ASSYNT (SCM_NULLP (SCM_CDR (x)) && len >= 2, xorig, "bad ELSE clause", "cond"); ASSYNT (SCM_NULLP (SCM_CDR (x)) && len >= 2, xorig, "bad ELSE clause", "cond");
SCM_CAR (arg1) = SCM_BOOL_T; SCM_SETCAR (arg1, SCM_BOOL_T);
} }
if (len >= 2 && scm_i_arrow == SCM_CAR (SCM_CDR (arg1))) if (len >= 2 && scm_i_arrow == SCM_CAR (SCM_CDR (arg1)))
ASSYNT (3 == len && SCM_NIMP (SCM_CAR (SCM_CDR (SCM_CDR (arg1)))), ASSYNT (3 == len && SCM_NIMP (SCM_CAR (SCM_CDR (SCM_CDR (arg1)))),
@ -538,7 +538,7 @@ scm_m_lambda (xorig, env)
(proc) (proc)
badforms:scm_wta (xorig, s_formals, "lambda"); badforms:scm_wta (xorig, s_formals, "lambda");
memlambda: memlambda:
bodycheck (xorig, &SCM_CDR (x), "lambda"); bodycheck (xorig, SCM_CDRLOC (x), "lambda");
return scm_cons (SCM_IM_LAMBDA, SCM_CDR (xorig)); return scm_cons (SCM_IM_LAMBDA, SCM_CDR (xorig));
} }
@ -560,11 +560,11 @@ scm_m_letstar (xorig, env)
ASSYNT (2 == scm_ilength (arg1), xorig, s_bindings, "let*"); ASSYNT (2 == scm_ilength (arg1), xorig, s_bindings, "let*");
ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), xorig, s_variable, "let*"); ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), xorig, s_variable, "let*");
*varloc = scm_cons2 (SCM_CAR (arg1), SCM_CAR (SCM_CDR (arg1)), SCM_EOL); *varloc = scm_cons2 (SCM_CAR (arg1), SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
varloc = &SCM_CDR (SCM_CDR (*varloc)); varloc = SCM_CDRLOC (SCM_CDR (*varloc));
proc = SCM_CDR (proc); proc = SCM_CDR (proc);
} }
x = scm_cons (vars, SCM_CDR (x)); x = scm_cons (vars, SCM_CDR (x));
bodycheck (xorig, &SCM_CDR (x), "let*"); bodycheck (xorig, SCM_CDRLOC (x), "let*");
return scm_cons (SCM_IM_LETSTAR, x); return scm_cons (SCM_IM_LETSTAR, x);
} }
@ -607,17 +607,17 @@ scm_m_do (xorig, env)
vars = scm_cons (SCM_CAR (arg1), vars); /* variable */ vars = scm_cons (SCM_CAR (arg1), vars); /* variable */
arg1 = SCM_CDR (arg1); arg1 = SCM_CDR (arg1);
*initloc = scm_cons (SCM_CAR (arg1), SCM_EOL); /* init */ *initloc = scm_cons (SCM_CAR (arg1), SCM_EOL); /* init */
initloc = &SCM_CDR (*initloc); initloc = SCM_CDRLOC (*initloc);
arg1 = SCM_CDR (arg1); arg1 = SCM_CDR (arg1);
*steploc = scm_cons (SCM_IMP (arg1) ? SCM_CAR (vars) : SCM_CAR (arg1), SCM_EOL); /* step */ *steploc = scm_cons (SCM_IMP (arg1) ? SCM_CAR (vars) : SCM_CAR (arg1), SCM_EOL); /* step */
steploc = &SCM_CDR (*steploc); steploc = SCM_CDRLOC (*steploc);
proc = SCM_CDR (proc); proc = SCM_CDR (proc);
} }
x = SCM_CDR (x); x = SCM_CDR (x);
ASSYNT (scm_ilength (SCM_CAR (x)) >= 1, xorig, s_test, "do"); ASSYNT (scm_ilength (SCM_CAR (x)) >= 1, xorig, s_test, "do");
x = scm_cons2 (SCM_CAR (x), SCM_CDR (x), steps); x = scm_cons2 (SCM_CAR (x), SCM_CDR (x), steps);
x = scm_cons2 (vars, inits, x); x = scm_cons2 (vars, inits, x);
bodycheck (xorig, &SCM_CAR (SCM_CDR (SCM_CDR (x))), "do"); bodycheck (xorig, SCM_CARLOC (SCM_CDR (SCM_CDR (x))), "do");
return scm_cons (SCM_IM_DO, x); return scm_cons (SCM_IM_DO, x);
} }
@ -755,7 +755,7 @@ scm_m_define (x, env)
if (5 <= scm_verbose && SCM_UNDEFINED != SCM_CDR (arg1)) if (5 <= scm_verbose && SCM_UNDEFINED != SCM_CDR (arg1))
scm_warn ("redefining ", SCM_CHARS (proc)); scm_warn ("redefining ", SCM_CHARS (proc));
#endif #endif
SCM_CDR (arg1) = x; SCM_SETCDR (arg1, x);
#ifdef SICP #ifdef SICP
return scm_cons2 (scm_i_quote, SCM_CAR (arg1), SCM_EOL); return scm_cons2 (scm_i_quote, SCM_CAR (arg1), SCM_EOL);
#else #else
@ -788,7 +788,7 @@ scm_m_undefine (x, env)
if (5 <= scm_verbose && SCM_UNDEFINED != SCM_CDR (arg1)) if (5 <= scm_verbose && SCM_UNDEFINED != SCM_CDR (arg1))
scm_warn ("redefining ", SCM_CHARS (x)); scm_warn ("redefining ", SCM_CHARS (x));
#endif #endif
SCM_CDR (arg1) = SCM_UNDEFINED; SCM_SETCDR (arg1, SCM_UNDEFINED);
#ifdef SICP #ifdef SICP
return SCM_CAR (arg1); return SCM_CAR (arg1);
#else #else
@ -822,12 +822,12 @@ scm_m_letrec (xorig, env)
ASRTSYNTAX (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), s_variable); ASRTSYNTAX (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), s_variable);
vars = scm_cons (SCM_CAR (arg1), vars); vars = scm_cons (SCM_CAR (arg1), vars);
*initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL); *initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
initloc = &SCM_CDR (*initloc); initloc = SCM_CDRLOC (*initloc);
} }
while SCM_NIMP while SCM_NIMP
(proc = SCM_CDR (proc)); (proc = SCM_CDR (proc));
cdrx = scm_cons2 (vars, inits, SCM_CDR (x)); cdrx = scm_cons2 (vars, inits, SCM_CDR (x));
bodycheck (xorig, &SCM_CDR (SCM_CDR (cdrx)), what); bodycheck (xorig, SCM_CDRLOC (SCM_CDR (cdrx)), what);
return scm_cons (SCM_IM_LETREC, cdrx); return scm_cons (SCM_IM_LETREC, cdrx);
} }
@ -864,9 +864,9 @@ scm_m_let (xorig, env)
ASSYNT (2 == scm_ilength (arg1), xorig, s_bindings, "let"); ASSYNT (2 == scm_ilength (arg1), xorig, s_bindings, "let");
ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), xorig, s_variable, "let"); ASSYNT (SCM_NIMP (SCM_CAR (arg1)) && SCM_SYMBOLP (SCM_CAR (arg1)), xorig, s_variable, "let");
*varloc = scm_cons (SCM_CAR (arg1), SCM_EOL); *varloc = scm_cons (SCM_CAR (arg1), SCM_EOL);
varloc = &SCM_CDR (*varloc); varloc = SCM_CDRLOC (*varloc);
*initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL); *initloc = scm_cons (SCM_CAR (SCM_CDR (arg1)), SCM_EOL);
initloc = &SCM_CDR (*initloc); initloc = SCM_CDRLOC (*initloc);
proc = SCM_CDR (proc); proc = SCM_CDR (proc);
} }
return return
@ -976,13 +976,15 @@ unmemocopy (x, env)
s = SCM_CDR (s); s = SCM_CDR (s);
} }
while SCM_NIMP (v); while SCM_NIMP (v);
SCM_CDR (ls) = z = scm_cons (z, SCM_UNSPECIFIED); z = scm_cons (z, SCM_UNSPECIFIED);
SCM_SETCDR (ls, z);
if (SCM_CAR (ls) == scm_i_do) if (SCM_CAR (ls) == scm_i_do)
{ {
x = SCM_CDR (x); x = SCM_CDR (x);
z = (SCM_CDR (z) = scm_cons (unmemocopy (SCM_CAR (x), env), SCM_SETCDR (z, scm_cons (unmemocopy (SCM_CAR (x), env),
SCM_UNSPECIFIED)); SCM_UNSPECIFIED));
x = (SCM) (&SCM_CAR (SCM_CDR (x)) - 1); z = SCM_CDR (z);
x = (SCM) (SCM_CARLOC (SCM_CDR (x)) - 1);
} }
break; break;
} }
@ -1011,15 +1013,16 @@ unmemocopy (x, env)
} }
do do
{ {
z = (SCM_CDR (z) = scm_acons (SCM_CAR (b), SCM_SETCDR (z, scm_acons (SCM_CAR (b),
unmemocar ( unmemocar (
scm_cons (unmemocopy (SCM_CAR (SCM_CDR (b)), env), SCM_EOL), env), scm_cons (unmemocopy (SCM_CAR (SCM_CDR (b)), env), SCM_EOL), env),
SCM_UNSPECIFIED)); SCM_UNSPECIFIED));
z = SCM_CDR (z);
env = EXTEND_ENV (SCM_CAR (b), SCM_BOOL_F, env); env = EXTEND_ENV (SCM_CAR (b), SCM_BOOL_F, env);
b = SCM_CDR (SCM_CDR (b)); b = SCM_CDR (SCM_CDR (b));
} }
while SCM_NIMP (b); while SCM_NIMP (b);
SCM_CDR (z) = SCM_EOL; SCM_SETCDR (z, SCM_EOL);
letstar: letstar:
ls = scm_cons (scm_i_letstar, z = scm_cons (y, SCM_UNSPECIFIED)); ls = scm_cons (scm_i_letstar, z = scm_cons (y, SCM_UNSPECIFIED));
break; break;
@ -1046,7 +1049,7 @@ unmemocopy (x, env)
ls = scm_cons (scm_i_define, ls = scm_cons (scm_i_define,
z = scm_cons (n = SCM_CAR (x), SCM_UNSPECIFIED)); z = scm_cons (n = SCM_CAR (x), SCM_UNSPECIFIED));
if (SCM_NNULLP (env)) if (SCM_NNULLP (env))
SCM_CAR (SCM_CAR (env)) = scm_cons (n, SCM_CAR (SCM_CAR (env))); SCM_SETCAR (SCM_CAR (env), scm_cons (n, SCM_CAR (SCM_CAR (env))));
break; break;
} }
case (127 & SCM_MAKISYM (0)): case (127 & SCM_MAKISYM (0)):
@ -1071,10 +1074,13 @@ unmemocopy (x, env)
} }
loop: loop:
while (SCM_CELLP (x = SCM_CDR (x)) && SCM_ECONSP (x)) while (SCM_CELLP (x = SCM_CDR (x)) && SCM_ECONSP (x))
z = (SCM_CDR (z) = unmemocar (scm_cons (unmemocopy (SCM_CAR (x), env), {
SCM_SETCDR (z, unmemocar (scm_cons (unmemocopy (SCM_CAR (x), env),
SCM_UNSPECIFIED), SCM_UNSPECIFIED),
env)); env));
SCM_CDR (z) = x; z = SCM_CDR (z);
}
SCM_SETCDR (z, x);
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
if (SCM_NFALSEP (p)) if (SCM_NFALSEP (p))
scm_whash_insert (scm_source_whash, ls, p); scm_whash_insert (scm_source_whash, ls, p);
@ -1131,7 +1137,7 @@ scm_eval_args (l, env)
while (SCM_NIMP (l)) while (SCM_NIMP (l))
{ {
*lloc = scm_cons (EVALCAR (l, env), SCM_EOL); *lloc = scm_cons (EVALCAR (l, env), SCM_EOL);
lloc = &SCM_CDR (*lloc); lloc = SCM_CDRLOC (*lloc);
l = SCM_CDR (l); l = SCM_CDR (l);
} }
return res; return res;
@ -1258,7 +1264,7 @@ scm_deval_args (l, env, lloc)
while (SCM_NIMP (l)) while (SCM_NIMP (l))
{ {
*lloc = scm_cons (EVALCAR (l, env), SCM_EOL); *lloc = scm_cons (EVALCAR (l, env), SCM_EOL);
lloc = &SCM_CDR (*lloc); lloc = SCM_CDRLOC (*lloc);
l = SCM_CDR (l); l = SCM_CDR (l);
} }
return *res; return *res;
@ -1575,7 +1581,7 @@ dispatch:
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1);
} }
while (SCM_NIMP (proc = SCM_CDR (proc))); while (SCM_NIMP (proc = SCM_CDR (proc)));
SCM_CDR (SCM_CAR (env)) = t.arg1; SCM_SETCDR (SCM_CAR (env), t.arg1);
goto cdrxnoap; goto cdrxnoap;
@ -1629,7 +1635,7 @@ dispatch:
t.lloc = scm_lookupcar (x, env); t.lloc = scm_lookupcar (x, env);
break; break;
case 1: case 1:
t.lloc = &SCM_GLOC_VAL (proc); t.lloc = SCM_GLOC_VAL_LOC (proc);
break; break;
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
case 4: case 4:
@ -1657,8 +1663,8 @@ dispatch:
#endif #endif
env = SCM_CAR (env); env = SCM_CAR (env);
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_CAR (env) = scm_cons (proc, SCM_CAR (env)); SCM_SETCAR (env, scm_cons (proc, SCM_CAR (env)));
SCM_CDR (env) = scm_cons (x, SCM_CDR (env)); SCM_SETCDR (env, scm_cons (x, SCM_CDR (env)));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
@ -1813,8 +1819,8 @@ dispatch:
} }
#endif #endif
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_CAR (x) = SCM_CAR (t.arg1); SCM_SETCAR (x, SCM_CAR (t.arg1));
SCM_CDR (x) = SCM_CDR (t.arg1); SCM_SETCDR (x, SCM_CDR (t.arg1));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
goto dispatch; goto dispatch;
} }
@ -1824,8 +1830,8 @@ dispatch:
scm_source_properties (x)); scm_source_properties (x));
#endif #endif
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_CAR (x) = SCM_CAR (t.arg1); SCM_SETCAR (x, SCM_CAR (t.arg1));
SCM_CDR (x) = SCM_CDR (t.arg1); SCM_SETCDR (x, SCM_CDR (t.arg1));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
goto loopnoap; goto loopnoap;
case 1: case 1:
@ -2080,7 +2086,7 @@ evapply:
} }
#ifdef DEVAL #ifdef DEVAL
debug.info->a.args = scm_cons2 (t.arg1, arg2, debug.info->a.args = scm_cons2 (t.arg1, arg2,
scm_deval_args (x, env, &SCM_CDR (SCM_CDR (debug.info->a.args)))); scm_deval_args (x, env, SCM_CDRLOC (SCM_CDR (debug.info->a.args))));
#endif #endif
ENTER_APPLY; ENTER_APPLY;
switch (SCM_TYP7 (proc)) switch (SCM_TYP7 (proc))
@ -2245,7 +2251,7 @@ scm_nconc2last (lst)
SCM_ASSERT (scm_ilength (lst) > 0, lst, SCM_ARG1, s_nconc2last); SCM_ASSERT (scm_ilength (lst) > 0, lst, SCM_ARG1, s_nconc2last);
lloc = &lst; lloc = &lst;
while (SCM_NNULLP (SCM_CDR (*lloc))) while (SCM_NNULLP (SCM_CDR (*lloc)))
lloc = &SCM_CDR (*lloc); lloc = SCM_CDRLOC (*lloc);
SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, s_nconc2last); SCM_ASSERT (scm_ilength (SCM_CAR (*lloc)) >= 0, lst, SCM_ARG1, s_nconc2last);
*lloc = SCM_CAR (*lloc); *lloc = SCM_CAR (*lloc);
return lst; return lst;
@ -2516,7 +2522,7 @@ scm_map (proc, arg1, args)
{ {
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG2, s_map); SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG2, s_map);
*pres = scm_cons (scm_apply (proc, SCM_CAR (arg1), scm_listofnull), SCM_EOL); *pres = scm_cons (scm_apply (proc, SCM_CAR (arg1), scm_listofnull), SCM_EOL);
pres = &SCM_CDR (*pres); pres = SCM_CDRLOC (*pres);
arg1 = SCM_CDR (arg1); arg1 = SCM_CDR (arg1);
} }
return res; return res;
@ -2538,7 +2544,7 @@ scm_map (proc, arg1, args)
ve[i] = SCM_CDR (ve[i]); ve[i] = SCM_CDR (ve[i]);
} }
*pres = scm_cons (scm_apply (proc, arg1, SCM_EOL), SCM_EOL); *pres = scm_cons (scm_apply (proc, arg1, SCM_EOL), SCM_EOL);
pres = &SCM_CDR (*pres); pres = SCM_CDRLOC (*pres);
} }
} }
@ -2596,7 +2602,7 @@ scm_closure (code, env)
register SCM z; register SCM z;
SCM_NEWCELL (z); SCM_NEWCELL (z);
SCM_SETCODE (z, code); SCM_SETCODE (z, code);
SCM_ENV (z) = env; SCM_SETENV (z, env);
return z; return z;
} }
@ -2609,8 +2615,8 @@ scm_makprom (code)
{ {
register SCM z; register SCM z;
SCM_NEWCELL (z); SCM_NEWCELL (z);
SCM_CDR (z) = code; SCM_SETCDR (z, code);
SCM_CAR (z) = scm_tc16_promise; SCM_SETCAR (z, scm_tc16_promise);
return z; return z;
} }
@ -2642,8 +2648,8 @@ scm_makacro (code)
{ {
register SCM z; register SCM z;
SCM_NEWCELL (z); SCM_NEWCELL (z);
SCM_CDR (z) = code; SCM_SETCDR (z, code);
SCM_CAR (z) = scm_tc16_macro; SCM_SETCAR (z, scm_tc16_macro);
return z; return z;
} }
@ -2656,8 +2662,8 @@ scm_makmacro (code)
{ {
register SCM z; register SCM z;
SCM_NEWCELL (z); SCM_NEWCELL (z);
SCM_CDR (z) = code; SCM_SETCDR (z, code);
SCM_CAR (z) = scm_tc16_macro | (1L << 16); SCM_SETCAR (z, scm_tc16_macro | (1L << 16));
return z; return z;
} }
@ -2670,8 +2676,8 @@ scm_makmmacro (code)
{ {
register SCM z; register SCM z;
SCM_NEWCELL (z); SCM_NEWCELL (z);
SCM_CDR (z) = code; SCM_SETCDR (z, code);
SCM_CAR (z) = scm_tc16_macro | (2L << 16); SCM_SETCAR (z, scm_tc16_macro | (2L << 16));
return z; return z;
} }
@ -2713,8 +2719,8 @@ scm_force (x)
if (!((1L << 16) & SCM_CAR (x))) if (!((1L << 16) & SCM_CAR (x)))
{ {
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_CDR (x) = ans; SCM_SETCDR (x, ans);
SCM_CAR (x) |= (1L << 16); SCM_SETOR_CAR (x, (1L << 16));
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
} }
} }
@ -2754,8 +2760,12 @@ scm_copy_tree (obj)
/* return scm_cons(scm_copy_tree(SCM_CAR(obj)), scm_copy_tree(SCM_CDR(obj))); */ /* return scm_cons(scm_copy_tree(SCM_CAR(obj)), scm_copy_tree(SCM_CDR(obj))); */
ans = tl = scm_cons (scm_copy_tree (SCM_CAR (obj)), SCM_UNSPECIFIED); ans = tl = scm_cons (scm_copy_tree (SCM_CAR (obj)), SCM_UNSPECIFIED);
while (SCM_NIMP (obj = SCM_CDR (obj)) && SCM_CONSP (obj)) while (SCM_NIMP (obj = SCM_CDR (obj)) && SCM_CONSP (obj))
tl = (SCM_CDR (tl) = scm_cons (scm_copy_tree (SCM_CAR (obj)), SCM_UNSPECIFIED)); {
SCM_CDR (tl) = obj; SCM_SETCDR (tl, scm_cons (scm_copy_tree (SCM_CAR (obj)),
SCM_UNSPECIFIED));
tl = SCM_CDR (tl);
}
SCM_SETCDR (tl, obj);
return ans; return ans;
} }
@ -2864,8 +2874,8 @@ scm_make_synt (name, macroizer, fcn)
tmp = 0; tmp = 0;
SCM_NEWCELL (z); SCM_NEWCELL (z);
SCM_SUBRF (z) = fcn; SCM_SUBRF (z) = fcn;
SCM_CAR (z) = tmp + scm_tc7_subr_2; SCM_SETCAR (z, tmp + scm_tc7_subr_2);
SCM_CDR (symcell) = macroizer (z); SCM_SETCDR (symcell, macroizer (z));
return SCM_CAR (symcell); return SCM_CAR (symcell);
} }