mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

* Another couple of SCM/scm_bits_t cleanups.

Browse source 
* eval.c:  replaced undef_cell by undef_object.
* eval.c:  made some struct vcell accesses explicit.
This commit is contained in:
Dirk Herrmann 2000-04-19 09:37:48 +00:00
parent f7c38587a9
commit 3201d76356
3 changed files with 71 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

23
libguile/ChangeLog
View file

@ -1,3 +1,25 @@
2000-04-19 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (undef_cell): Removed, replaced by:
(undef_object): Added to replace undef_cell.
(scm_lookupcar, scm_lookupcar1): Use undef_object.
* eval.c (scm_lookupcar, scm_lookupcar1, scm_m_atfop,
scm_m_atbind, CHECK_EQVISH, SCM_CEVAL), procs.h (SCM_SETCODE):
Don't perform arithmetic operations with SCM values.
* eval.c (scm_lookupcar, scm_lookupcar1, scm_m_atfop,
scm_m_atbind, scm_eval_args, scm_deval_args, SCM_CEVAL): Use
symbolic names for the tc3 type codes.
* eval.c (scm_m_define, SCM_CEVAL, SCM_APPLY): Remove redundant
cast to SCM.
* eval.c (scm_eval_args, scm_deval_args, SCM_CEVAL): Made the
access of the struct vcell element explicit.
2000-04-19 Mikael Djurfeldt <mdj@thalamus.nada.kth.se> 2000-04-19 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
* struct.c (scm_struct_free_light, scm_struct_free_standard, * struct.c (scm_struct_free_light, scm_struct_free_standard,
@ -82,7 +104,6 @@
* eval.h (SCM_IFRAME, SCM_IDIST), weaks.h (SCM_IS_WHVEC_ANY): * eval.h (SCM_IFRAME, SCM_IDIST), weaks.h (SCM_IS_WHVEC_ANY):
Added missing call to SCM_UNPACK. Added missing call to SCM_UNPACK.
>>>>>>> 1.913
2000-04-17 Mikael Djurfeldt <mdj@thalamus.nada.kth.se> 2000-04-17 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
* validate.h (SCM_VALIDATE_INUM_RANGE_COPY, * validate.h (SCM_VALIDATE_INUM_RANGE_COPY,

81
libguile/eval.c
View file

@ -256,7 +256,7 @@ scm_ilookup (SCM iloc, SCM env)
/* scm_lookupcar returns a pointer to this when a variable could not /* scm_lookupcar returns a pointer to this when a variable could not
be found and it should not throw an error. Never assign to this. be found and it should not throw an error. Never assign to this.
*/ */
static scm_cell undef_cell = { SCM_UNDEFINED, SCM_UNDEFINED }; static SCM undef_object = SCM_UNDEFINED;
SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable"); SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable");
@ -292,7 +292,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
if (! SCM_EQ_P (SCM_CAR (vloc), var)) if (! SCM_EQ_P (SCM_CAR (vloc), var))
goto race; goto race;
#endif #endif
SCM_SETCAR (vloc, iloc + SCM_ICDR); SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (iloc) + SCM_ICDR);
#endif #endif
return SCM_CDRLOC (*al); return SCM_CDRLOC (*al);
} }
@ -319,11 +319,11 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
return SCM_CARLOC (*al); return SCM_CARLOC (*al);
} }
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
iloc += SCM_IDINC; iloc = SCM_PACK (SCM_UNPACK (iloc) + SCM_IDINC);
#endif #endif
} }
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
iloc = SCM_PACK ((~SCM_IDSTMSK) & SCM_UNPACK(iloc + SCM_IFRINC)); iloc = SCM_PACK ((~SCM_IDSTMSK) & (SCM_UNPACK(iloc) + SCM_IFRINC));
#endif #endif
} }
{ {
@ -357,7 +357,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
scm_cons (var, SCM_EOL)); scm_cons (var, SCM_EOL));
} }
else else
return SCM_CDRLOC (&undef_cell); return &undef_object;
} }
#endif #endif
#ifdef USE_THREADS #ifdef USE_THREADS
@ -368,7 +368,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
completely. */ completely. */
race: race:
var = SCM_CAR (vloc); var = SCM_CAR (vloc);
if (SCM_ITAG3 (var) == 1) if (SCM_ITAG3 (var) == scm_tc3_cons_gloc)
return SCM_GLOC_VAL_LOC (var); return SCM_GLOC_VAL_LOC (var);
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
if ((SCM_UNPACK (var) & 127) == (127 & SCM_UNPACK (SCM_ILOC00))) if ((SCM_UNPACK (var) & 127) == (127 & SCM_UNPACK (SCM_ILOC00)))
@ -383,7 +383,7 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
} }
#endif /* USE_THREADS */ #endif /* USE_THREADS */
SCM_SETCAR (vloc, var + 1); SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (var) + scm_tc3_cons_gloc);
/* 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_CDRLOC (var); return SCM_CDRLOC (var);
@ -915,7 +915,7 @@ scm_m_define (SCM x, SCM env)
arg1 = scm_sym2vcell (proc, scm_env_top_level (env), SCM_BOOL_T); arg1 = scm_sym2vcell (proc, scm_env_top_level (env), SCM_BOOL_T);
#if 0 #if 0
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
if (SCM_NIMP (SCM_CDR (arg1)) && ((SCM) SCM_SNAME (SCM_CDR (arg1)) == proc) if (SCM_NIMP (SCM_CDR (arg1)) && (SCM_SNAME (SCM_CDR (arg1)) == proc)
&& (SCM_CDR (arg1) != x)) && (SCM_CDR (arg1) != x))
scm_warn ("redefining built-in ", SCM_CHARS (proc)); scm_warn ("redefining built-in ", SCM_CHARS (proc));
else else
@ -1143,7 +1143,7 @@ scm_m_atfop (SCM xorig, SCM env)
vcell = scm_symbol_fref (SCM_CAR (x)); vcell = scm_symbol_fref (SCM_CAR (x));
SCM_ASSYNT (SCM_CONSP (vcell), x, SCM_ASSYNT (SCM_CONSP (vcell), x,
"Symbol's function definition is void", NULL); "Symbol's function definition is void", NULL);
SCM_SETCAR (x, vcell + 1); SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (vcell) + scm_tc3_cons_gloc);
return x; return x;
} }
@ -1169,7 +1169,7 @@ scm_m_atbind (SCM xorig, SCM env)
x = SCM_CAR (x); x = SCM_CAR (x);
while (SCM_NIMP (x)) while (SCM_NIMP (x))
{ {
SCM_SETCAR (x, scm_sym2vcell (SCM_CAR (x), env, SCM_BOOL_T) + 1); SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (scm_sym2vcell (SCM_CAR (x), env, SCM_BOOL_T)) + scm_tc3_cons_gloc);
x = SCM_CDR (x); x = SCM_CDR (x);
} }
return scm_cons (SCM_IM_BIND, SCM_CDR (xorig)); return scm_cons (SCM_IM_BIND, SCM_CDR (xorig));
@ -1539,10 +1539,13 @@ scm_eval_args (SCM l, SCM env, SCM proc)
else else
res = EVALCELLCAR (l, env); res = EVALCELLCAR (l, env);
} }
else if (SCM_TYP3 (l) == 1) else if (SCM_TYP3 (l) == scm_tc3_cons_gloc)
{ {
if ((res = SCM_GLOC_VAL (SCM_CAR (l))) == 0) scm_bits_t vcell = SCM_STRUCT_VTABLE_DATA (l) [scm_vtable_index_vcell];
if (vcell == 0)
res = SCM_CAR (l); /* struct planted in code */ res = SCM_CAR (l); /* struct planted in code */
else
res = SCM_PACK (vcell);
} }
else else
goto wrongnumargs; goto wrongnumargs;
@ -1758,10 +1761,13 @@ scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
else else
res = EVALCELLCAR (l, env); res = EVALCELLCAR (l, env);
} }
else if (SCM_TYP3 (l) == 1) else if (SCM_TYP3 (l) == scm_tc3_cons_gloc)
{ {
if ((res = SCM_GLOC_VAL (SCM_CAR (l))) == 0) scm_bits_t vcell = SCM_STRUCT_VTABLE_DATA (l) [scm_vtable_index_vcell];
if (vcell == 0)
res = SCM_CAR (l); /* struct planted in code */ res = SCM_CAR (l); /* struct planted in code */
else
res = SCM_PACK (vcell);
} }
else else
goto wrongnumargs; goto wrongnumargs;
@ -1789,7 +1795,7 @@ scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
*/ */
#ifndef DEVAL #ifndef DEVAL
#define CHECK_EQVISH(A,B) (((A) == (B)) || (SCM_NFALSEP (scm_eqv_p ((A), (B))))) #define CHECK_EQVISH(A,B) (SCM_EQ_P ((A), (B)) || (SCM_NFALSEP (scm_eqv_p ((A), (B)))))
#endif /* DEVAL */ #endif /* DEVAL */
#define BUILTIN_RPASUBR /* Handle rpsubrs and asubrs without calling apply */ #define BUILTIN_RPASUBR /* Handle rpsubrs and asubrs without calling apply */
@ -2141,16 +2147,16 @@ dispatch:
case SCM_BIT8(SCM_IM_SET_X): case SCM_BIT8(SCM_IM_SET_X):
x = SCM_CDR (x); x = SCM_CDR (x);
proc = SCM_CAR (x); proc = SCM_CAR (x);
switch (7 & (int) proc) switch (SCM_ITAG3 (proc))
{ {
case 0: case scm_tc3_cons:
t.lloc = scm_lookupcar (x, env, 1); t.lloc = scm_lookupcar (x, env, 1);
break; break;
case 1: case scm_tc3_cons_gloc:
t.lloc = SCM_GLOC_VAL_LOC (proc); t.lloc = SCM_GLOC_VAL_LOC (proc);
break; break;
#ifdef MEMOIZE_LOCALS #ifdef MEMOIZE_LOCALS
case 4: case scm_tc3_imm24:
t.lloc = scm_ilookup (proc, env); t.lloc = scm_ilookup (proc, env);
break; break;
#endif #endif
@ -2359,7 +2365,7 @@ dispatch:
while (SCM_NIMP (x = SCM_CDR (proc))) while (SCM_NIMP (x = SCM_CDR (proc)))
{ {
if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env)) if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env))
|| t.arg1 == scm_lisp_nil)) || SCM_EQ_P (t.arg1, scm_lisp_nil)))
{ {
if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED)) if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED))
RETURN (t.arg1); RETURN (t.arg1);
@ -2387,7 +2393,7 @@ dispatch:
while (SCM_NIMP (x = SCM_CDR (proc))) while (SCM_NIMP (x = SCM_CDR (proc)))
{ {
if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env)) if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env))
|| t.arg1 == SCM_INUM0)) || SCM_EQ_P (t.arg1, SCM_INUM0)))
{ {
if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED)) if (SCM_EQ_P (SCM_CAR (x), SCM_UNSPECIFIED))
RETURN (t.arg1); RETURN (t.arg1);
@ -2499,19 +2505,22 @@ dispatch:
#endif /* ifdef MEMOIZE_LOCALS */ #endif /* ifdef MEMOIZE_LOCALS */
case scm_tcs_cons_gloc: case scm_tcs_cons_gloc: {
proc = SCM_GLOC_VAL (SCM_CAR (x)); scm_bits_t vcell = SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_vcell];
if (proc == 0) if (vcell == 0) {
/* This is a struct implanted in the code, not a gloc. */ /* This is a struct implanted in the code, not a gloc. */
RETURN (x); RETURN (x);
SCM_ASRTGO (SCM_NIMP (proc), badfun); } else {
proc = SCM_PACK (vcell);
SCM_ASRTGO (SCM_NIMP (proc), badfun);
#ifndef SCM_RECKLESS #ifndef SCM_RECKLESS
#ifdef SCM_CAUTIOUS #ifdef SCM_CAUTIOUS
goto checkargs; goto checkargs;
#endif #endif
#endif #endif
}
break; break;
}
case scm_tcs_cons_nimcar: case scm_tcs_cons_nimcar:
if (SCM_SYMBOLP (SCM_CAR (x))) if (SCM_SYMBOLP (SCM_CAR (x)))
@ -2711,10 +2720,13 @@ evapply:
else else
t.arg1 = EVALCELLCAR (x, env); t.arg1 = EVALCELLCAR (x, env);
} }
else if (SCM_TYP3 (x) == 1) else if (SCM_TYP3 (x) == scm_tc3_cons_gloc)
{ {
if ((t.arg1 = SCM_GLOC_VAL (SCM_CAR (x))) == 0) scm_bits_t vcell = SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_vcell];
if (vcell == 0)
t.arg1 = SCM_CAR (x); /* struct planted in code */ t.arg1 = SCM_CAR (x); /* struct planted in code */
else
t.arg1 = SCM_PACK (vcell);
} }
else else
goto wrongnumargs; goto wrongnumargs;
@ -2759,7 +2771,7 @@ evapply:
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), t.arg1, SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), t.arg1,
SCM_ARG1, SCM_CHARS (SCM_SNAME (proc))); SCM_ARG1, SCM_CHARS (SCM_SNAME (proc)));
} }
proc = (SCM) SCM_SNAME (proc); proc = SCM_SNAME (proc);
{ {
char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1; char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1;
while ('c' != *--chrs) while ('c' != *--chrs)
@ -2856,10 +2868,13 @@ evapply:
else else
arg2 = EVALCELLCAR (x, env); arg2 = EVALCELLCAR (x, env);
} }
else if (SCM_TYP3 (x) == 1) else if (SCM_TYP3 (x) == scm_tc3_cons_gloc)
{ {
if ((arg2 = SCM_GLOC_VAL (SCM_CAR (x))) == 0) scm_bits_t vcell = SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_vcell];
if (vcell == 0)
arg2 = SCM_CAR (x); /* struct planted in code */ arg2 = SCM_CAR (x); /* struct planted in code */
else
arg2 = SCM_PACK (vcell);
} }
else else
goto wrongnumargs; goto wrongnumargs;
@ -3350,7 +3365,7 @@ tail:
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1, SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_CHARS (SCM_SNAME (proc))); SCM_ARG1, SCM_CHARS (SCM_SNAME (proc)));
} }
proc = (SCM) SCM_SNAME (proc); proc = SCM_SNAME (proc);
{ {
char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1; char *chrs = SCM_CHARS (proc) + SCM_LENGTH (proc) - 1;
while ('c' != *--chrs) while ('c' != *--chrs)

2
libguile/procs.h
View file

@ -105,7 +105,7 @@ typedef struct
#define SCM_CODE(x) SCM_CAR (SCM_CLOSCAR (x)) #define SCM_CODE(x) SCM_CAR (SCM_CLOSCAR (x))
#define SCM_PROCPROPS(x) SCM_CDR (SCM_CLOSCAR (x)) #define SCM_PROCPROPS(x) SCM_CDR (SCM_CLOSCAR (x))
#define SCM_SETPROCPROPS(x, p) SCM_SETCDR (SCM_CLOSCAR (x), p) #define SCM_SETPROCPROPS(x, p) SCM_SETCDR (SCM_CLOSCAR (x), p)
#define SCM_SETCODE(x, e) (SCM_SETCAR (x, scm_cons ((e), SCM_EOL)\ #define SCM_SETCODE(x, e) (SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (scm_cons ((e), SCM_EOL)) \
+ scm_tc3_closure)) + scm_tc3_closure))
#define SCM_ENV(x) SCM_CDR(x) #define SCM_ENV(x) SCM_CDR(x)
#define SCM_SETENV(x, e) SCM_SETCDR (x, e) #define SCM_SETENV(x, e) SCM_SETCDR (x, e)