mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00
Code Activity

* alist.c, arbiters.c, continuations.c, debug.c, debug.h, eval.c,

Browse source 
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:31:08 +00:00
parent a23afe534a
commit a6c64c3c6d
23 changed files with 85 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/alist.c
View file

@ -58,12 +58,12 @@ scm_acons (w, x, y)
{
register SCM z;
SCM_NEWCELL (z);
SCM_CAR (z) = w;
SCM_CDR (z) = x;
SCM_SETCAR (z, w);
SCM_SETCDR (z, x);
x = z;
SCM_NEWCELL (z);
SCM_CAR (z) = x;
SCM_CDR (z) = y;
SCM_SETCAR (z, x);
SCM_SETCDR (z, y);
return z;
}

8
libguile/arbiters.c
View file

@ -84,8 +84,8 @@ scm_make_arbiter (name)
{
register SCM z;
SCM_NEWCELL (z);
SCM_CDR (z) = name;
SCM_CAR (z) = scm_tc16_arbiter;
SCM_SETCDR (z, name);
SCM_SETCAR (z, scm_tc16_arbiter);
return z;
}
@ -101,7 +101,7 @@ scm_try_arbiter (arb)
arb = SCM_BOOL_F;
else
{
SCM_CAR (arb) = scm_tc16_arbiter | (1L << 16);
SCM_SETCAR (arb, scm_tc16_arbiter | (1L << 16));
arb = SCM_BOOL_T;
}
SCM_ALLOW_INTS;
@ -118,7 +118,7 @@ scm_release_arbiter (arb)
SCM_ASSERT ((SCM_TYP16 (arb) == scm_tc16_arbiter), arb, SCM_ARG1, s_release_arbiter);
if (!(SCM_CAR (arb) & (1L << 16)))
return SCM_BOOL_F;
SCM_CAR (arb) = scm_tc16_arbiter;
SCM_SETCAR (arb, scm_tc16_arbiter);
return SCM_BOOL_T;
}

2
libguile/continuations.c
View file

@ -69,7 +69,7 @@ scm_make_cont (answer)
*answer = cont;
SCM_DEFER_INTS;
SCM_SETJMPBUF (cont, scm_must_malloc ((long) sizeof (scm_contregs), s_cont));
SCM_CAR (cont) = scm_tc7_contin;
SCM_SETCAR (cont, scm_tc7_contin);
SCM_DYNENV (cont) = scm_dynwinds;
SCM_THROW_VALUE = SCM_EOL;
SCM_BASE (cont) = SCM_BASE (rootcont);

12
libguile/debug.c
View file

@ -171,11 +171,11 @@ scm_make_memoized (exp, env)
register SCM z, ans;
SCM_DEFER_INTS;
SCM_NEWCELL (z);
SCM_CAR (z) = exp;
SCM_CDR (z) = env;
SCM_SETCAR (z, exp);
SCM_SETCDR (z, env);
SCM_NEWCELL (ans);
SCM_CAR (ans) = scm_tc16_memoized;
SCM_CDR (ans) = z;
SCM_SETCAR (ans, scm_tc16_memoized);
SCM_SETCDR (ans, z);
SCM_ALLOW_INTS;
return ans;
}
@ -378,8 +378,8 @@ scm_make_debugobj (frame)
register SCM z;
SCM_DEFER_INTS;
SCM_NEWCELL (z);
SCM_CAR (z) = scm_tc16_debugobj;
SCM_DEBUGOBJ_FRAME (z) = (SCM) frame;
SCM_SETCAR (z, scm_tc16_debugobj);
SCM_SET_DEBUGOBJ_FRAME (z, (SCM) frame);
SCM_ALLOW_INTS;
return z;
}

1
libguile/debug.h
View file

@ -166,6 +166,7 @@ extern long scm_tc16_debugobj;
#define SCM_DEBUGOBJP(x) (scm_tc16_debugobj == SCM_TYP16 (x))
#define SCM_DEBUGOBJ_FRAME(x) SCM_CDR (x)
#define SCM_SET_DEBUGOBJ_FRAME(x, f) SCM_SETCDR (x, f)
/* {Memoized Source}
*/

4
libguile/filesys.c
View file

@ -719,7 +719,7 @@ scm_sys_opendir (dirname)
SCM_SYSCALL (ds = opendir (SCM_CHARS (dirname)));
if (ds == NULL)
scm_syserror (s_sys_opendir);
SCM_CAR (dir) = scm_tc16_dir | SCM_OPN;
SCM_SETCAR (dir, scm_tc16_dir | SCM_OPN);
SCM_SETCDR (dir, ds);
SCM_ALLOW_INTS;
return dir;
@ -777,7 +777,7 @@ scm_sys_closedir (port)
SCM_SYSCALL (sts = closedir ((DIR *) SCM_CDR (port)));
if (sts != 0)
scm_syserror (s_sys_closedir);
SCM_CAR (port) = scm_tc16_dir;
SCM_SETCAR (port, scm_tc16_dir);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}

3
libguile/fports.c
View file

@ -170,7 +170,8 @@ scm_open_file (filename, modes)
pt = scm_add_to_port_table (port);
SCM_SETPTAB_ENTRY (port, pt);
if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (mode)))
SCM_SETCAR (port, scm_tc16_fport | scm_mode_bits (mode));
if (SCM_BUF0 & SCM_CAR (port))
scm_setbuf0 (port);
SCM_SETSTREAM (port, (SCM) f);
SCM_PTAB_ENTRY (port)->file_name = filename;

4
libguile/gsubr.c
View file

@ -99,10 +99,10 @@ scm_make_gsubr(name, req, opt, rst, fcn)
tmp = 0;
SCM_NEWCELL(z);
SCM_SUBRF(z) = fcn;
SCM_CAR(z) = tmp + scm_tc7_subr_0;
SCM_SETCAR (z, tmp + scm_tc7_subr_0);
GSUBR_PROC(cclo) = z;
GSUBR_TYPE(cclo) = SCM_MAKINUM(GSUBR_MAKTYPE(req, opt, rst));
SCM_CDR(symcell) = cclo;
SCM_SETCDR (symcell, cclo);
#ifdef DEBUG_EXTENSIONS
if (SCM_REC_PROCNAMES_P)
scm_set_procedure_property_x (cclo, scm_i_name, SCM_CAR (symcell));

6
libguile/kw.c
View file

@ -101,11 +101,11 @@ scm_make_keyword_from_dash_symbol (symbol)
{
SCM kw;
SCM_NEWCELL(kw);
SCM_CAR(kw) = (SCM)scm_tc16_kw;
SCM_CDR(kw) = symbol;
SCM_SETCAR (kw, (SCM)scm_tc16_kw);
SCM_SETCDR (kw, symbol);
scm_intern_symbol (scm_kw_obarray, symbol);
vcell = scm_sym2ovcell_soft (symbol, scm_kw_obarray);
SCM_CDR (vcell) = kw;
SCM_SETCDR (vcell, kw);
}
SCM_ALLOW_INTS;
return SCM_CDR (vcell);

4
libguile/mallocs.c
View file

@ -88,8 +88,8 @@ scm_malloc_obj (n)
SCM_ALLOW_INTS;
return SCM_BOOL_F;
}
SCM_CDR (answer) = mem;
SCM_CAR (answer) = scm_tc16_malloc;
SCM_SETCDR (answer, mem);
SCM_SETCAR (answer, scm_tc16_malloc);
SCM_ALLOW_INTS;
return answer;
}

18
libguile/numbers.c
View file

@ -939,7 +939,7 @@ scm_addbig(x, nx, xsgn, bigy, sgny)
} while (++i < nx);
if (num && nx==ny) {
num = 1; i = 0;
SCM_CAR(z) ^= 0x0100;
SCM_SETCAR (z, SCM_CAR (z) ^ 0x0100);
do {
num += (SCM_BIGRAD-1) - zds[i];
zds[i++] = SCM_BIGLO(num);
@ -1819,18 +1819,18 @@ scm_makdbl (x, y)
if ((-FLTMAX < x) && (x < FLTMAX) && (fx==x))
# endif
{
SCM_CAR(z) = scm_tc_flo;
SCM_SETCAR (z, scm_tc_flo);
SCM_FLO(z) = x;
SCM_ALLOW_INTS;
return z;
}
# endif/* def SCM_SINGLES */
SCM_CDR(z) = (SCM)scm_must_malloc(1L*sizeof(double), "real");
SCM_CAR(z) = scm_tc_dblr;
SCM_SETCDR (z, (SCM)scm_must_malloc(1L*sizeof(double), "real"));
SCM_SETCAR (z, scm_tc_dblr);
}
else {
SCM_CDR(z) = (SCM)scm_must_malloc(2L*sizeof(double), "complex");
SCM_CAR(z) = scm_tc_dblc;
SCM_SETCDR (z, (SCM)scm_must_malloc(2L*sizeof(double), "complex"));
SCM_SETCAR (z, scm_tc_dblc);
SCM_IMAG(z) = y;
}
SCM_REAL(z) = x;
@ -3686,12 +3686,12 @@ scm_init_numbers ()
#ifdef SCM_FLOATS
SCM_NEWCELL(scm_flo0);
# ifdef SCM_SINGLES
SCM_CAR(scm_flo0) = scm_tc_flo;
SCM_SETCAR (scm_flo0, scm_tc_flo);
SCM_FLO(scm_flo0) = 0.0;
# else
SCM_CDR(scm_flo0) = (SCM)scm_must_malloc(1L*sizeof(double), "real");
SCM_SETCDR (scm_flo0, (SCM)scm_must_malloc(1L*sizeof(double), "real"));
SCM_REAL(scm_flo0) = 0.0;
SCM_CAR(scm_flo0) = scm_tc_dblr;
SCM_SETCAR (scm_flo0, scm_tc_dblr);
# endif
# ifdef DBL_DIG
scm_dblprec = (DBL_DIG > 20) ? 20 : DBL_DIG;

2
libguile/numbers.h
View file

@ -197,7 +197,7 @@
#define SCM_BIGSIGN(x) (0x0100 & (int)SCM_CAR(x))
#define SCM_BDIGITS(x) ((SCM_BIGDIG *)(SCM_CDR(x)))
#define SCM_NUMDIGS(x) ((scm_sizet)(SCM_CAR(x)>>16))
#define SCM_SETNUMDIGS(x, v, t) SCM_CAR(x) = (((v)+0L)<<16)+(t)
#define SCM_SETNUMDIGS(x, v, t) SCM_SETCAR(x, (((v)+0L)<<16)+(t))
#ifdef SCM_FLOATS

16
libguile/pairs.c
View file

@ -56,8 +56,8 @@ scm_cons (x, y)
{
register SCM z;
SCM_NEWCELL (z);
SCM_CAR (z) = x;
SCM_CDR (z) = y;
SCM_SETCAR (z, x);
SCM_SETCDR (z, y);
return z;
}
@ -70,12 +70,12 @@ scm_cons2 (w, x, y)
{
register SCM z;
SCM_NEWCELL (z);
SCM_CAR (z) = x;
SCM_CDR (z) = y;
SCM_SETCAR (z, x);
SCM_SETCDR (z, y);
x = z;
SCM_NEWCELL (z);
SCM_CAR (z) = w;
SCM_CDR (z) = x;
SCM_SETCAR (z, w);
SCM_SETCDR (z, x);
return z;
}
@ -98,7 +98,7 @@ scm_set_car_x(pair, value)
SCM value;
{
SCM_ASSERT(SCM_NIMP(pair) && SCM_CONSP(pair), pair, SCM_ARG1, s_set_car_x);
SCM_CAR(pair) = value;
SCM_SETCAR (pair, value);
return value;
}
@ -110,7 +110,7 @@ scm_set_cdr_x(pair, value)
SCM value;
{
SCM_ASSERT(SCM_NIMP(pair) && SCM_CONSP(pair), pair, SCM_ARG1, s_set_cdr_x);
SCM_CDR(pair) = value;
SCM_SETCDR (pair, value);
return value;
}

8
libguile/posix.c
View file

@ -224,8 +224,8 @@ scm_sys_pipe ()
ptw = scm_add_to_port_table (p_wt);
SCM_SETPTAB_ENTRY (p_rd, ptr);
SCM_SETPTAB_ENTRY (p_wt, ptw);
SCM_CAR (p_rd) = scm_tc16_fport | scm_mode_bits ("r");
SCM_CAR (p_wt) = scm_tc16_fport | scm_mode_bits ("w");
SCM_SETCAR (p_rd, scm_tc16_fport | scm_mode_bits ("r"));
SCM_SETCAR (p_wt, scm_tc16_fport | scm_mode_bits ("w"));
SCM_SETSTREAM (p_rd, (SCM)f_rd);
SCM_SETSTREAM (p_wt, (SCM)f_wt);
@ -875,8 +875,8 @@ scm_open_pipe (pipestr, modes)
scm_syserror (s_open_pipe);
pt = scm_add_to_port_table (z);
SCM_SETPTAB_ENTRY (z, pt);
SCM_CAR (z) = scm_tc16_pipe | SCM_OPN
| (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG);
SCM_SETCAR (z, scm_tc16_pipe | SCM_OPN
| (strchr (SCM_ROCHARS (modes), 'r') ? SCM_RDNG : SCM_WRTNG));
SCM_SETSTREAM (z, (SCM)f);
SCM_ALLOW_INTS;
return z;

4
libguile/procprop.c
View file

@ -88,7 +88,7 @@ scm_set_procedure_properties_x (proc, new_val)
if (!(SCM_NIMP (proc) && SCM_CLOSUREP (proc)))
proc = scm_stand_in_scm_proc(proc);
SCM_ASSERT (SCM_NIMP (proc) && SCM_CLOSUREP (proc), proc, SCM_ARG1, s_set_procedure_properties_x);
SCM_PROCPROPS (proc) = new_val;
SCM_SETPROCPROPS (proc, new_val);
return SCM_UNSPECIFIED;
}
@ -123,7 +123,7 @@ scm_set_procedure_property_x (p, k, v)
if (SCM_NIMP (assoc))
SCM_SETCDR (assoc, v);
else
SCM_PROCPROPS (p) = scm_acons (k, v, SCM_PROCPROPS (p));
SCM_SETPROCPROPS (p, scm_acons (k, v, SCM_PROCPROPS (p)));
return SCM_UNSPECIFIED;
}

4
libguile/procs.c
View file

@ -67,9 +67,9 @@ scm_make_subr_opt (name, type, fcn, set)
tmp = 0;
SCM_NEWCELL (z);
SCM_SUBRF (z) = fcn;
SCM_CAR (z) = tmp + type;
SCM_SETCAR (z, tmp + type);
if (set)
SCM_CDR (symcell) = z;
SCM_SETCDR (symcell, z);
return z;
}

4
libguile/procs.h
View file

@ -82,8 +82,10 @@ typedef struct scm_dsubr
#define SCM_CLOSCAR(x) (SCM_CAR(x)-scm_tc3_closure)
#define SCM_CODE(x) SCM_CAR(SCM_CLOSCAR (x))
#define SCM_PROCPROPS(x) SCM_CDR(SCM_CLOSCAR (x))
#define SCM_SETCODE(x, e) SCM_CAR(x) = (scm_cons ((e), SCM_EOL) + scm_tc3_closure)
#define SCM_SETPROCPROPS(x, p) SCM_SETCDR(SCM_CLOSCAR (x), p)
#define SCM_SETCODE(x, e) (SCM_SETCAR (x, scm_cons ((e), SCM_EOL) + scm_tc3_closure))
#define SCM_ENV(x) SCM_CDR(x)
#define SCM_SETENV(x, e) SCM_SETCDR (x, e)
#define SCM_TOP_LEVEL(SCM_ENV) (SCM_NULLP(SCM_ENV) || (SCM_BOOL_T == scm_procedure_p (SCM_CAR (SCM_ENV))))

12
libguile/read.c
View file

@ -213,12 +213,15 @@ recsexpr (obj, line, column, filename)
copy = scm_cons (recsexpr (SCM_CAR (obj), line, column, filename),
SCM_UNDEFINED);
while (SCM_NIMP (tmp = SCM_CDR (tmp)) && SCM_CONSP (tmp))
copy = (SCM_CDR (copy) = scm_cons (recsexpr (SCM_CAR (tmp),
{
SCM_SETCDR (copy, scm_cons (recsexpr (SCM_CAR (tmp),
line,
column,
filename),
SCM_UNDEFINED));
SCM_CDR (copy) = tmp;
copy = SCM_CDR (copy);
}
SCM_SETCDR (copy, tmp);
}
else
{
@ -641,10 +644,11 @@ scm_lreadparen (tok_buf, port, name, case_i, sharp, copy)
scm_gen_ungetc (c, port);
if (scm_i_dot == (tmp = scm_lreadr (tok_buf, port, case_i, sharp, copy)))
{
SCM_CDR (tl) = scm_lreadr (tok_buf, port, case_i, sharp, copy);
SCM_SETCDR (tl, scm_lreadr (tok_buf, port, case_i, sharp, copy));
goto closeit;
}
tl = (SCM_CDR (tl) = scm_cons (tmp, SCM_EOL));
SCM_SETCDR (tl, scm_cons (tmp, SCM_EOL));
tl = SCM_CDR (tl);
}
return ans;
}

2
libguile/root.c
View file

@ -193,7 +193,7 @@ cwdr (proc, a1, args, handler, stack_start)
SCM_SETJMPBUF (new_rootcont,
scm_must_malloc ((long) sizeof (scm_contregs),
"inferior root continuation"));
SCM_CAR (new_rootcont) = scm_tc7_contin;
SCM_SETCAR (new_rootcont, scm_tc7_contin);
SCM_DYNENV (new_rootcont) = SCM_EOL;
SCM_BASE (new_rootcont) = stack_start;
SCM_SEQ (new_rootcont) = ++n_dynamic_roots;

4
libguile/srcprop.c
View file

@ -157,12 +157,12 @@ scm_make_srcprops (line, col, filename, copy, plist)
srcprops_freelist = (scm_srcprops *) &ptr[1];
}
SCM_NEWCELL (ans);
SCM_CAR (ans) = scm_tc16_srcprops;
SCM_SETCAR (ans, scm_tc16_srcprops);
ptr->pos = SRCPROPMAKPOS (line, col);
ptr->fname = filename;
ptr->copy = copy;
ptr->plist = plist;
SCM_CDR (ans) = (SCM) ptr;
SCM_SETCDR (ans, (SCM) ptr);
SCM_ALLOW_INTS;
return ans;
}

8
libguile/strports.c
View file

@ -84,7 +84,7 @@ stputc (c, p)
scm_vector_set_length_x (SCM_CDR (p), SCM_MAKINUM (ind + (ind >> 1)));
SCM_ALLOW_INTS;
SCM_CHARS (SCM_CDR (p))[ind] = c;
SCM_CAR (p) = SCM_MAKINUM (ind + 1);
SCM_SETCAR (p, SCM_MAKINUM (ind + 1));
return c;
}
@ -108,7 +108,7 @@ stwrite (str, siz, num, p)
dst = &(SCM_CHARS (SCM_CDR (p))[ind]);
while (len--)
dst[len] = str[len];
SCM_CAR (p) = SCM_MAKINUM (ind + siz * num);
SCM_SETCAR (p, SCM_MAKINUM (ind + siz * num));
return num;
}
@ -134,7 +134,7 @@ stgetc (p)
scm_sizet ind = SCM_INUM (SCM_CAR (p));
if (ind >= SCM_ROLENGTH (SCM_CDR (p)))
return EOF;
SCM_CAR (p) = SCM_MAKINUM (ind + 1);
SCM_SETCAR (p, SCM_MAKINUM (ind + 1));
return SCM_ROUCHARS (SCM_CDR (p))[ind];
}
@ -156,7 +156,7 @@ scm_mkstrport (pos, str, modes, caller)
SCM_NEWCELL (z);
SCM_DEFER_INTS;
pt = scm_add_to_port_table (z);
SCM_CAR (z) = scm_tc16_strport | modes;
SCM_SETCAR (z, scm_tc16_strport | modes);
SCM_SETPTAB_ENTRY (z, pt);
SCM_SETSTREAM (z, stream);
SCM_ALLOW_INTS;

16
libguile/variable.c
View file

@ -113,8 +113,8 @@ make_vcell_variable (vcell)
SCM answer;
SCM_NEWCELL(answer);
SCM_REDEFER_INTS;
SCM_CAR(answer) = scm_tc16_variable;
SCM_CDR(answer) = vcell;
SCM_SETCAR (answer, scm_tc16_variable);
SCM_SETCDR (answer, vcell);
SCM_REALLOW_INTS;
return answer;
}
@ -133,8 +133,8 @@ scm_make_variable (init, name_hint)
SCM_NEWCELL(val_cell);
SCM_DEFER_INTS;
SCM_CAR(val_cell) = name_hint;
SCM_CDR(val_cell) = init;
SCM_SETCAR (val_cell, name_hint);
SCM_SETCDR (val_cell, init);
SCM_ALLOW_INTS;
return make_vcell_variable (val_cell);
}
@ -153,8 +153,8 @@ scm_make_undefined_variable (name_hint)
SCM_NEWCELL (vcell);
SCM_DEFER_INTS;
SCM_CAR (vcell) = name_hint;
SCM_CDR (vcell) = SCM_UNDEFINED;
SCM_SETCAR (vcell, name_hint);
SCM_SETCDR (vcell, SCM_UNDEFINED);
SCM_ALLOW_INTS;
return make_vcell_variable (vcell);
}
@ -192,7 +192,7 @@ scm_variable_set_x (var, val)
SCM val;
{
SCM_ASSERT (SCM_NIMP(var) && SCM_VARIABLEP (var), var, SCM_ARG1, s_variable_set_x);
SCM_CDR (SCM_CDR (var)) = val;
SCM_SETCDR (SCM_CDR (var), val);
return SCM_UNSPECIFIED;
}
@ -217,7 +217,7 @@ scm_builtin_variable (name)
SCM_DEFER_INTS;
if ( SCM_IMP (SCM_CDR (var_slot))
|| (SCM_VARVCELL (var_slot) != vcell))
SCM_CDR (var_slot) = make_vcell_variable (vcell);
SCM_SETCDR (var_slot, make_vcell_variable (vcell));
SCM_ALLOW_INTS;
return SCM_CDR (var_slot);

2
libguile/vports.c
View file

@ -184,7 +184,7 @@ scm_make_soft_port (pv, modes)
SCM_NEWCELL (z);
SCM_DEFER_INTS;
pt = scm_add_to_port_table (z);
SCM_CAR (z) = scm_tc16_sfport | scm_mode_bits (SCM_CHARS (modes));
SCM_SETCAR (z, scm_tc16_sfport | scm_mode_bits (SCM_CHARS (modes)));
SCM_SETPTAB_ENTRY (z, pt);
SCM_SETSTREAM (z, pv);
SCM_ALLOW_INTS;