* Replaced a lot of calls to SCM_C[AD]R with more appropriate macros.

* Minor cleanups to hashtable implementation.
* Minor code beautifications.

diff --git a/libguile/async.c b/libguile/async.c
index e57b821..ae3f5dc 100644 (file)
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 96, 97, 98, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -130,7 +130,7 @@ scm_asyncs_pending ()
 {
   SCM pos;
   pos = scm_asyncs;
-  while (pos != SCM_EOL)
+  while (!SCM_NULLP (pos))
     {
       SCM a = SCM_CAR (pos);
       if (ASYNC_GOT_IT (a))
@@ -300,14 +300,8 @@ SCM_DEFINE (scm_system_async, "system-async", 1, 0, 0,
            "add it to the system's list of active async objects.")
 #define FUNC_NAME s_scm_system_async
 {
-  SCM it;
-  SCM list;
-
-  it = scm_async (thunk);
-  SCM_NEWCELL (list);
-  SCM_SETCAR (list, it);
-  SCM_SETCDR (list, scm_asyncs);
-  scm_asyncs = list;
+  SCM it = scm_async (thunk);
+  scm_asyncs = scm_cons (it, scm_asyncs);
   return it;
 }
 #undef FUNC_NAME

diff --git a/libguile/debug.c b/libguile/debug.c
index 7c1cf8b..3b4f77f 100644 (file)
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -504,11 +504,10 @@ SCM_REGISTER_PROC (s_reverse_lookup, "reverse-lookup", 2, 0, 0, scm_reverse_look
 SCM
 scm_reverse_lookup (SCM env, SCM data)
 {
-  SCM names, values;
-  while (SCM_NIMP (env) && SCM_SLOPPY_CONSP (SCM_CAR (env)))
+  while (SCM_CONSP (env) && SCM_CONSP (SCM_CAR (env)))
     {
-      names = SCM_CAAR (env);
-      values = SCM_CDAR (env);
+      SCM names = SCM_CAAR (env);
+      SCM values = SCM_CDAR (env);
       while (SCM_CONSP (names))
        {
          if (SCM_EQ_P (SCM_CAR (values), data))
@@ -516,7 +515,7 @@ scm_reverse_lookup (SCM env, SCM data)
          names = SCM_CDR (names);
          values = SCM_CDR (values);
        }
-      if (! SCM_NULLP (names) && SCM_EQ_P (values, data))
+      if (!SCM_NULLP (names) && SCM_EQ_P (values, data))
        return names;
       env = SCM_CDR (env);
     }

diff --git a/libguile/eq.c b/libguile/eq.c
index 8eda340..0bb7f08 100644 (file)
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1997,1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -136,7 +136,7 @@ SCM_DEFINE1 (scm_equal_p, "equal?", scm_tc7_rpsubr,
     return SCM_BOOL_F;
   if (SCM_IMP (y))
     return SCM_BOOL_F;
-  if (SCM_SLOPPY_CONSP (x) && SCM_SLOPPY_CONSP (y))
+  if (SCM_CONSP (x) && SCM_CONSP (y))
     {
       if (SCM_FALSEP (scm_equal_p (SCM_CAR (x), SCM_CAR (y))))
        return SCM_BOOL_F;

diff --git a/libguile/eval.c b/libguile/eval.c
index 0d3c620..67d9034 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -150,7 +150,7 @@ char *alloca ();
                             ? *scm_lookupcar (x, env, 1) \
                             : SCM_CEVAL (SCM_CAR (x), env))
 
-#define EVALCAR(x, env) (SCM_NCELLP (SCM_CAR (x)) \
+#define EVALCAR(x, env) (!SCM_CELLP (SCM_CAR (x)) \
                        ? (SCM_IMP (SCM_CAR (x)) \
                           ? SCM_EVALIM (SCM_CAR (x), env) \
                           : SCM_GLOC_VAL (SCM_CAR (x))) \
@@ -790,11 +790,11 @@ scm_m_quasiquote (SCM xorig, SCM env)
 
 
 static SCM 
-iqq (SCM form,SCM env,int depth)
+iqq (SCM form, SCM env, int depth)
 {
   SCM tmp;
   int edepth = depth;
-  if (SCM_IMP(form))
+  if (SCM_IMP (form))
     return form;
   if (SCM_VECTORP (form))
     {
@@ -805,7 +805,7 @@ iqq (SCM form,SCM env,int depth)
        tmp = scm_cons (data[i], tmp);
       return scm_vector (iqq (tmp, env, depth));
     }
-  if (SCM_NCONSP(form)) 
+  if (!SCM_CONSP (form)) 
     return form;
   tmp = SCM_CAR (form);
   if (SCM_EQ_P (scm_sym_quasiquote, tmp))
@@ -824,7 +824,7 @@ iqq (SCM form,SCM env,int depth)
        return evalcar (form, env);
       return scm_cons2 (tmp, iqq (SCM_CAR (form), env, depth), SCM_EOL);
     }
-  if (SCM_NIMP (tmp) && (SCM_EQ_P (scm_sym_uq_splicing, SCM_CAR (tmp))))
+  if (SCM_CONSP (tmp) && (SCM_EQ_P (scm_sym_uq_splicing, SCM_CAR (tmp))))
     {
       tmp = SCM_CDR (tmp);
       if (0 == --edepth)
@@ -876,10 +876,11 @@ scm_m_define (SCM x, SCM env)
              /* Only the first definition determines the name. */
              && SCM_FALSEP (scm_procedure_property (arg1, scm_sym_name)))
            scm_set_procedure_property_x (arg1, scm_sym_name, proc);
-         else if (SCM_TYP16 (arg1) == scm_tc16_macro
-                  && !SCM_EQ_P (SCM_CDR (arg1), arg1))
+         else if (SCM_MACROP (arg1)
+                  /* Dirk::FIXME: Does the following test make sense? */
+                  && !SCM_EQ_P (SCM_MACRO_CODE (arg1), arg1))
            {
-             arg1 = SCM_CDR (arg1);
+             arg1 = SCM_MACRO_CODE (arg1);
              goto proc;
            }
        }
@@ -1144,19 +1145,17 @@ scm_m_at_call_with_values (SCM xorig, SCM env)
 SCM
 scm_m_expand_body (SCM xorig, SCM env)
 {
-  SCM form, x = SCM_CDR (xorig), defs = SCM_EOL;
+  SCM x = SCM_CDR (xorig), defs = SCM_EOL;
   char *what = SCM_ISYMCHARS (SCM_CAR (xorig)) + 2;
 
   while (SCM_NIMP (x))
     {
-      form = SCM_CAR (x);
-      if (SCM_IMP (form) || SCM_NCONSP (form))
-       break;
-      if (SCM_IMP (SCM_CAR (form)))
+      SCM form = SCM_CAR (x);
+      if (!SCM_CONSP (form))
        break;
       if (!SCM_SYMBOLP (SCM_CAR (form)))
        break;
- 
+
       form = scm_macroexp (scm_cons_source (form,
                                            SCM_CAR (form),
                                            SCM_CDR (form)),
@@ -1165,9 +1164,9 @@ scm_m_expand_body (SCM xorig, SCM env)
       if (SCM_EQ_P (SCM_IM_DEFINE, SCM_CAR (form)))
        {
          defs = scm_cons (SCM_CDR (form), defs);
-         x = SCM_CDR(x);
+         x = SCM_CDR (x);
        }
-      else if (SCM_NIMP(defs))
+      else if (!SCM_IMP (defs))
        {
          break;
        }
@@ -1177,7 +1176,7 @@ scm_m_expand_body (SCM xorig, SCM env)
        }
       else
        {
-         x = scm_cons (form, SCM_CDR(x));
+         x = scm_cons (form, SCM_CDR (x));
          break;
        }
     }
@@ -1229,13 +1228,11 @@ scm_macroexp (SCM x, SCM env)
   /* Only handle memoizing macros.  `Acros' and `macros' are really
      special forms and should not be evaluated here. */
 
-  if (SCM_IMP (proc)
-      || scm_tc16_macro != SCM_TYP16 (proc)
-      || (SCM_CELL_WORD_0 (proc) >> 16) != 2)
+  if (!SCM_MACROP (proc) || SCM_MACRO_TYPE (proc) != 2)
     return x;
 
   unmemocar (x, env);
-  res = scm_apply (SCM_CDR (proc), x, scm_cons (env, scm_listofnull));
+  res = scm_apply (SCM_MACRO_CODE (proc), x, scm_cons (env, scm_listofnull));
   
   if (scm_ilength (res) <= 0)
     res = scm_cons2 (SCM_IM_BEGIN, res, SCM_EOL);
@@ -1510,7 +1507,7 @@ SCM
 scm_eval_args (SCM l, SCM env, SCM proc)
 {
   SCM results = SCM_EOL, *lloc = &results, res;
-  while (SCM_NIMP (l))
+  while (!SCM_IMP (l))
     {
 #ifdef SCM_CAUTIOUS
       if (SCM_CONSP (l))
@@ -1538,7 +1535,7 @@ scm_eval_args (SCM l, SCM env, SCM proc)
       l = SCM_CDR (l);
     }
 #ifdef SCM_CAUTIOUS
-  if (SCM_NNULLP (l))
+  if (!SCM_NULLP (l))
     {
     wrongnumargs:
       scm_wrong_num_args (proc);
@@ -1733,7 +1730,7 @@ SCM
 scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
 {
   SCM *results = lloc, res;
-  while (SCM_NIMP (l))
+  while (!SCM_IMP (l))
     {
 #ifdef SCM_CAUTIOUS
       if (SCM_CONSP (l))
@@ -1761,7 +1758,7 @@ scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
       l = SCM_CDR (l);
     }
 #ifdef SCM_CAUTIOUS
-  if (SCM_NNULLP (l))
+  if (!SCM_NULLP (l))
     {
     wrongnumargs:
       scm_wrong_num_args (proc);
@@ -1943,11 +1940,11 @@ dispatch:
     begin:
       /* If we are on toplevel with a lookup closure, we need to sync
          with the current module. */
-      if (SCM_CONSP(env) && !SCM_CONSP(SCM_CAR(env)))
+      if (SCM_CONSP (env) && !SCM_CONSP (SCM_CAR (env)))
        {
          t.arg1 = x;
          UPDATE_TOPLEVEL_ENV (env);
-         while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1)))
+         while (!SCM_NULLP (t.arg1 = SCM_CDR (t.arg1)))
            {
              EVALCAR (x, env);
              x = t.arg1;
@@ -1964,7 +1961,7 @@ dispatch:
       x = SCM_CDR (x);
     nontoplevel_begin:
       t.arg1 = x;
-      while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1)))
+      while (!SCM_NULLP (t.arg1 = SCM_CDR (t.arg1)))
        {
          if (SCM_IMP (SCM_CAR (x)))
            {
@@ -1974,7 +1971,7 @@ dispatch:
                  goto nontoplevel_begin;
                }
              else
-               SCM_EVALIM2 (SCM_CAR(x));
+               SCM_EVALIM2 (SCM_CAR (x));
            }
          else
            SCM_CEVAL (SCM_CAR (x), env);
@@ -1982,7 +1979,7 @@ dispatch:
        }
       
     carloop:                   /* scm_eval car of last form in list */
-      if (SCM_NCELLP (SCM_CAR (x)))
+      if (!SCM_CELLP (SCM_CAR (x)))
        {
          x = SCM_CAR (x);
          RETURN (SCM_IMP (x) ? SCM_EVALIM (x, env) : SCM_GLOC_VAL (x))
@@ -2026,18 +2023,18 @@ dispatch:
 
 
     case SCM_BIT8(SCM_IM_COND):
-      while (SCM_NIMP (x = SCM_CDR (x)))
+      while (!SCM_IMP (x = SCM_CDR (x)))
        {
          proc = SCM_CAR (x);
          t.arg1 = EVALCAR (proc, env);
          if (SCM_NFALSEP (t.arg1))
            {
              x = SCM_CDR (proc);
-             if SCM_NULLP (x)
+             if (SCM_NULLP (x))
                {
                  RETURN (t.arg1)
                }
-             if (! SCM_EQ_P (scm_sym_arrow, SCM_CAR (x)))
+             if (!SCM_EQ_P (scm_sym_arrow, SCM_CAR (x)))
                {
                  PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
                  goto begin;
@@ -2147,10 +2144,10 @@ dispatch:
     case SCM_BIT8(SCM_IM_OR):
       x = SCM_CDR (x);
       t.arg1 = x;
-      while (SCM_NNULLP (t.arg1 = SCM_CDR (t.arg1)))
+      while (!SCM_NULLP (t.arg1 = SCM_CDR (t.arg1)))
        {
          x = EVALCAR (x, env);
-         if (SCM_NFALSEP (x))
+         if (!SCM_FALSEP (x))
            {
              RETURN (x);
            }
@@ -2576,7 +2573,7 @@ dispatch:
              unmemocar (x, env);
              goto badfun;
            }
-         if (scm_tc16_macro == SCM_TYP16 (proc))
+         if (SCM_MACROP (proc))
            {
              unmemocar (x, env);
 
@@ -2586,19 +2583,19 @@ dispatch:
                 application frames can be deleted from the backtrace. */
              SCM_SET_MACROEXP (debug);
 #endif
-             t.arg1 = SCM_APPLY (SCM_CDR (proc), x,
+             t.arg1 = SCM_APPLY (SCM_MACRO_CODE (proc), x,
                                  scm_cons (env, scm_listofnull));
 
 #ifdef DEVAL
              SCM_CLEAR_MACROEXP (debug);
 #endif
-             switch (SCM_CELL_WORD_0 (proc) >> 16)
+             switch (SCM_MACRO_TYPE (proc))
                {
                case 2:
                  if (scm_ilength (t.arg1) <= 0)
                    t.arg1 = scm_cons2 (SCM_IM_BEGIN, t.arg1, SCM_EOL);
 #ifdef DEVAL
-                 if (!SCM_CLOSUREP (SCM_CDR (proc)))
+                 if (!SCM_CLOSUREP (SCM_MACRO_CODE (proc)))
                    {
                      SCM_DEFER_INTS;
                      SCM_SETCAR (x, SCM_CAR (t.arg1));
@@ -2626,7 +2623,7 @@ dispatch:
        }
       else
        proc = SCM_CEVAL (SCM_CAR (x), env);
-      SCM_ASRTGO (SCM_NIMP (proc), badfun);
+      SCM_ASRTGO (!SCM_IMP (proc), badfun);
 #ifndef SCM_RECKLESS
 #ifdef SCM_CAUTIOUS
     checkargs:
@@ -2635,19 +2632,19 @@ dispatch:
        {
          arg2 = SCM_CAR (SCM_CODE (proc));
          t.arg1 = SCM_CDR (x);
-         while (SCM_NIMP (arg2))
+         while (!SCM_IMP (arg2))
            {
-             if (SCM_NCONSP (arg2))
+             if (!SCM_CONSP (arg2))
                goto evapply;
              if (SCM_IMP (t.arg1))
                goto umwrongnumargs;
              arg2 = SCM_CDR (arg2);
              t.arg1 = SCM_CDR (t.arg1);
            }
-         if (SCM_NNULLP (t.arg1))
+         if (!SCM_NULLP (t.arg1))
            goto umwrongnumargs;
        }
-      else if (scm_tc16_macro == SCM_TYP16 (proc))
+      else if (SCM_MACROP (proc))
        goto handle_a_macro;
 #endif
     }
@@ -3778,7 +3775,7 @@ promise_print (SCM exp, SCM port, scm_print_state *pstate)
   int writingp = SCM_WRITINGP (pstate);
   scm_puts ("#<promise ", port);
   SCM_SET_WRITINGP (pstate, 1);
-  scm_iprin1 (SCM_CDR (exp), port, pstate);
+  scm_iprin1 (SCM_CELL_WORD_1 (exp), port, pstate);
   SCM_SET_WRITINGP (pstate, writingp);
   scm_putc ('>', port);
   return !0;

diff --git a/libguile/eval.h b/libguile/eval.h
index ec387a4..60c5d73 100644 (file)
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -1,8 +1,8 @@
 /* classes: h_files */
 
-#ifndef EVALH
-#define EVALH
-/*     Copyright (C) 1995, 1996 ,1998, 1999, 2000 Free Software Foundation, Inc.
+#ifndef SCM_EVAL_H
+#define SCM_EVAL_H
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -180,8 +180,6 @@ extern SCM scm_sym_args;
 
 extern SCM scm_f_apply;
 
-extern scm_bits_t scm_tc16_macro;
-
 /* A resolved global variable reference in the CAR position
  * of a list is stored (in code only) as a pointer to a pair with a 
  * tag of 1.  This is called a "gloc".
@@ -259,7 +257,7 @@ extern SCM scm_eval_x (SCM exp, SCM module);
 
 extern void scm_init_eval (void);
 
-#endif  /* EVALH */
+#endif  /* SCM_EVAL_H */
 
 /*
   Local Variables:

diff --git a/libguile/fluids.c b/libguile/fluids.c
index a52b2c8..a76b05c 100644 (file)
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -183,7 +183,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
 void
 scm_swap_fluids (SCM fluids, SCM vals)
 {
-  while (SCM_NIMP (fluids))
+  while (!SCM_NULLP (fluids))
     {
       SCM fl = SCM_CAR (fluids);
       SCM old_val = scm_fluid_ref (fl);
@@ -200,7 +200,7 @@ same fluid appears multiple times in the fluids list. */
 void
 scm_swap_fluids_reverse (SCM fluids, SCM vals)
 {
-  if (SCM_NIMP (fluids))
+  if (!SCM_NULLP (fluids))
     {
       SCM fl, old_val;
 

diff --git a/libguile/gc.c b/libguile/gc.c
index ebcddca..a433678 100644 (file)
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000, 2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -1183,8 +1183,8 @@ gc_mark_loop_first_time:
       ptr = SCM_CDR (ptr);
       goto gc_mark_loop;
     case scm_tc7_pws:
-      RECURSE (SCM_CELL_OBJECT_2 (ptr));
-      ptr = SCM_CDR (ptr);
+      RECURSE (SCM_SETTER (ptr));
+      ptr = SCM_PROCEDURE (ptr);
       goto gc_mark_loop;
     case scm_tcs_cons_gloc:
       {
@@ -1241,13 +1241,13 @@ gc_mark_loop_first_time:
       }
       break;
     case scm_tcs_closures:
-      if (SCM_IMP (SCM_CDR (ptr)))
+      if (SCM_IMP (SCM_ENV (ptr)))
        {
          ptr = SCM_CLOSCAR (ptr);
          goto gc_mark_nimp;
        }
       RECURSE (SCM_CLOSCAR (ptr));
-      ptr = SCM_CDR (ptr);
+      ptr = SCM_ENV (ptr);
       goto gc_mark_nimp;
     case scm_tc7_vector:
       i = SCM_VECTOR_LENGTH (ptr);
@@ -1541,8 +1541,8 @@ gc_sweep_freelist_finish (scm_freelist_t *freelist)
   if (!SCM_NULLP (freelist->cells))
     {
       SCM c = freelist->cells;
-      SCM_SETCAR (c, SCM_CDR (c));
-      SCM_SETCDR (c, SCM_EOL);
+      SCM_SET_CELL_WORD_0 (c, SCM_FREE_CELL_CDR (c));
+      SCM_SET_CELL_WORD_1 (c, SCM_EOL);
       freelist->collected +=
        freelist->span * (freelist->cluster_size - freelist->left_to_collect);
     }
@@ -1733,7 +1733,7 @@ scm_gc_sweep ()
                  SCM_SETSTREAM (scmptr, 0);
                  scm_remove_from_port_table (scmptr);
                  scm_gc_ports_collected++;
-                 SCM_SETAND_CAR (scmptr, ~SCM_OPN);
+                 SCM_CLR_PORT_OPEN_FLAG (scmptr);
                }
              break;
            case scm_tc7_smob:
@@ -1770,7 +1770,7 @@ scm_gc_sweep ()
 
          if (!--left_to_collect)
            {
-             SCM_SETCAR (scmptr, nfreelist);
+             SCM_SET_CELL_WORD_0 (scmptr, nfreelist);
              *freelist->clustertail = scmptr;
              freelist->clustertail = SCM_CDRLOC (scmptr);
 
@@ -2130,7 +2130,7 @@ init_heap_seg (SCM_CELLPTR seg_org, scm_sizet size, scm_freelist_t *freelist)
               }
 
            SCM_SET_CELL_TYPE (scmptr, scm_tc_free_cell);
-           SCM_SETCDR (scmptr, PTR2SCM (nxt));
+           SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (nxt));
 
             ptr = nxt;
          }
@@ -2463,7 +2463,7 @@ scm_unprotect_object (SCM obj)
 
   handle = scm_hashq_get_handle (scm_protects, obj);
 
-  if (SCM_IMP (handle))
+  if (SCM_FALSEP (handle))
     {
       fprintf (stderr, "scm_unprotect_object called on unprotected object\n");
       abort ();

diff --git a/libguile/guardians.c b/libguile/guardians.c
index fbecd9d..f7eac28 100644 (file)
--- a/libguile/guardians.c
+++ b/libguile/guardians.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -89,8 +89,8 @@ typedef struct tconc_t
 #define TCONC_IN(tc, obj, pair) \
 do { \
   SCM_SETCAR ((tc).tail, obj); \
-  SCM_SETCAR (pair, SCM_BOOL_F); \
-  SCM_SETCDR (pair, SCM_EOL); \
+  SCM_SET_CELL_WORD_0 (pair, SCM_BOOL_F); \
+  SCM_SET_CELL_WORD_1 (pair, SCM_EOL); \
   SCM_SETCDR ((tc).tail, pair); \
   (tc).tail = pair; \
 } while (0)
@@ -258,7 +258,7 @@ scm_guard (SCM guardian, SCM obj, int throw_p)
 
       if (GREEDY_P (g))
         {
-          if (SCM_NFALSEP (scm_hashq_get_handle
+          if (!SCM_FALSEP (scm_hashq_get_handle
                            (greedily_guarded_whash, obj)))
             {
               SCM_ALLOW_INTS;

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 54500fd..9bcc168 100644 (file)
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -60,21 +60,24 @@ scm_c_make_hash_table (unsigned long k)
   return scm_c_make_vector (k, SCM_EOL);
 }
 
+
 SCM
 scm_hash_fn_get_handle (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn)(),void * closure)
+#define FUNC_NAME "scm_hash_fn_get_handle"
 {
   unsigned int k;
   SCM h;
 
-  SCM_ASSERT (SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_get_handle");
+  SCM_VALIDATE_VECTOR (1, table);
   if (SCM_VECTOR_LENGTH (table) == 0)
-    return SCM_EOL;
+    return SCM_BOOL_F;
   k = hash_fn (obj, SCM_VECTOR_LENGTH (table), closure);
   if (k >= SCM_VECTOR_LENGTH (table))
     scm_out_of_range ("hash_fn_get_handle", scm_ulong2num (k));
   h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
   return h;
 }
+#undef FUNC_NAME
 
 
 SCM
@@ -116,13 +119,11 @@ SCM
 scm_hash_fn_ref (SCM table,SCM obj,SCM dflt,unsigned int (*hash_fn)(),
                  SCM (*assoc_fn)(),void * closure)
 {
-  SCM it;
-
-  it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
-  if (SCM_IMP (it))
-    return dflt;
-  else
+  SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
+  if (SCM_CONSP (it))
     return SCM_CDR (it);
+  else
+    return dflt;
 }
 
 
@@ -165,16 +166,14 @@ scm_hash_fn_remove_x (SCM table,SCM obj,unsigned int (*hash_fn)(),SCM (*assoc_fn
 \f
 
 SCM_DEFINE (scm_hashq_get_handle, "hashq-get-handle", 2, 0, 0,
-            (SCM table, SCM obj),
-           "This procedure is similar to its @code{-ref} cousin, but returns a\n"
-           "@dfn{handle} from the hash table rather than the value associated with\n"
-           "@var{key}.  By convention, a handle in a hash table is the pair which\n"
-           "associates a key with a value.  Where @code{hashq-ref table key} returns\n"
-           "only a @code{value}, @code{hashq-get-handle table key} returns the pair\n"
-           "@code{(key . value)}.")
+            (SCM table, SCM key),
+           "This procedure returns the @code{(key . value)} pair from the\n"
+           "hash table @var{table}.  If @var{table} does not hold an\n"
+           "associated value for @var{key}, @code{#f} is returned.\n"
+           "Uses @code{eq?} for equality testing.")
 #define FUNC_NAME s_scm_hashq_get_handle
 {
-  return scm_hash_fn_get_handle (table, obj, scm_ihashq, scm_sloppy_assq, 0);
+  return scm_hash_fn_get_handle (table, key, scm_ihashq, scm_sloppy_assq, 0);
 }
 #undef FUNC_NAME
 
@@ -233,16 +232,14 @@ SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0,
 \f
 
 SCM_DEFINE (scm_hashv_get_handle, "hashv-get-handle", 2, 0, 0,
-            (SCM table, SCM obj),
-           "This procedure is similar to its @code{-ref} cousin, but returns a\n"
-           "@dfn{handle} from the hash table rather than the value associated with\n"
-           "@var{key}.  By convention, a handle in a hash table is the pair which\n"
-           "associates a key with a value.  Where @code{hashv-ref table key} returns\n"
-           "only a @code{value}, @code{hashv-get-handle table key} returns the pair\n"
-           "@code{(key . value)}.")
+            (SCM table, SCM key),
+           "This procedure returns the @code{(key . value)} pair from the\n"
+           "hash table @var{table}.  If @var{table} does not hold an\n"
+           "associated value for @var{key}, @code{#f} is returned.\n"
+           "Uses @code{eqv?} for equality testing.")
 #define FUNC_NAME s_scm_hashv_get_handle
 {
-  return scm_hash_fn_get_handle (table, obj, scm_ihashv, scm_sloppy_assv, 0);
+  return scm_hash_fn_get_handle (table, key, scm_ihashv, scm_sloppy_assv, 0);
 }
 #undef FUNC_NAME
 
@@ -299,16 +296,14 @@ SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0,
 \f
 
 SCM_DEFINE (scm_hash_get_handle, "hash-get-handle", 2, 0, 0,
-            (SCM table, SCM obj),
-           "This procedure is similar to its @code{-ref} cousin, but returns a\n"
-           "@dfn{handle} from the hash table rather than the value associated with\n"
-           "@var{key}.  By convention, a handle in a hash table is the pair which\n"
-           "associates a key with a value.  Where @code{hash-ref table key} returns\n"
-           "only a @code{value}, @code{hash-get-handle table key} returns the pair\n"
-           "@code{(key . value)}.")
+            (SCM table, SCM key),
+           "This procedure returns the @code{(key . value)} pair from the\n"
+           "hash table @var{table}.  If @var{table} does not hold an\n"
+           "associated value for @var{key}, @code{#f} is returned.\n"
+           "Uses @code{equal?} for equality testing.")
 #define FUNC_NAME s_scm_hash_get_handle
 {
-  return scm_hash_fn_get_handle (table, obj, scm_ihash, scm_sloppy_assoc, 0);
+  return scm_hash_fn_get_handle (table, key, scm_ihash, scm_sloppy_assoc, 0);
 }
 #undef FUNC_NAME
 
@@ -543,7 +538,7 @@ scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
   for (i = 0; i < n; ++i)
     {
       SCM ls = SCM_VELTS (table)[i], handle;
-      while (SCM_NNULLP (ls))
+      while (!SCM_NULLP (ls))
        {
          SCM_ASSERT (SCM_CONSP (ls),
                      table, SCM_ARG1, s_scm_hash_fold);

diff --git a/libguile/keywords.c b/libguile/keywords.c
index 84d942d..3509314 100644 (file)
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -112,7 +112,7 @@ SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0,
            "Returns @code{#t} if the argument @var{obj} is a keyword, else @code{#f}.")
 #define FUNC_NAME s_scm_keyword_p
 {
-  return SCM_BOOL(SCM_KEYWORDP (obj));
+  return SCM_BOOL (SCM_KEYWORDP (obj));
 }
 #undef FUNC_NAME
 
@@ -123,8 +123,8 @@ SCM_DEFINE (scm_keyword_dash_symbol, "keyword-dash-symbol", 1, 0, 0,
            "This is the inverse of @code{make-keyword-from-dash-symbol}.")
 #define FUNC_NAME s_scm_keyword_dash_symbol
 {
-  SCM_VALIDATE_KEYWORD (1,keyword);
-  return SCM_CDR (keyword);
+  SCM_VALIDATE_KEYWORD (1, keyword);
+  return SCM_KEYWORDSYM (keyword);
 }
 #undef FUNC_NAME
 

diff --git a/libguile/macros.h b/libguile/macros.h
index 92436fe..ccc80df 100644 (file)
--- a/libguile/macros.h
+++ b/libguile/macros.h
@@ -1,8 +1,8 @@
 /* classes: h_files */
 
-#ifndef MACROSH
-#define MACROSH
-/*     Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+#ifndef SCM_MACROS_H
+#define SCM_MACROS_H
+/* Copyright (C) 1998,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -51,6 +51,10 @@
 #define SCM_ASSYNT(_cond, _msg, _subr) \
   if (!(_cond)) scm_misc_error (_subr, _msg, SCM_EOL);
 
+#define SCM_MACROP(x) SCM_TYP16_PREDICATE (scm_tc16_macro, (x))
+#define SCM_MACRO_TYPE(m) (SCM_CELL_WORD_0 (m) >> 16)
+#define SCM_MACRO_CODE(m) SCM_CELL_OBJECT_1 (m)
+
 extern scm_bits_t scm_tc16_macro;
 
 extern SCM scm_makacro (SCM code);
@@ -65,7 +69,7 @@ extern SCM scm_make_synt (const char *name,
                           SCM (*fcn) ());
 extern void scm_init_macros (void);
 
-#endif /* MACROSH */
+#endif /* SCM_MACROS_H */
 
 /*
   Local Variables:

diff --git a/libguile/ports.c b/libguile/ports.c
index 6884811..c480b7f 100644 (file)
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -663,7 +663,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
   else
     rv = 0;
   scm_remove_from_port_table (port);
-  SCM_SETAND_CAR (port, ~SCM_OPN);
+  SCM_CLR_PORT_OPEN_FLAG (port);
   return SCM_NEGATE_BOOL (rv < 0);
 }
 #undef FUNC_NAME

diff --git a/libguile/ports.h b/libguile/ports.h
index fabf744..c8c96aa 100644 (file)
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -1,8 +1,8 @@
 /* classes: h_files */
 
-#ifndef PORTSH
-#define PORTSH
-/*     Copyright (C) 1995,1996,1997,1998,1999, 2000, 2001 Free Software Foundation, Inc.
+#ifndef SCM_PORTS_H
+#define SCM_PORTS_H
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -152,7 +152,7 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table.  */
 #define SCM_BUF0       (8L<<16) /* Is it unbuffered? */
 #define SCM_BUFLINE     (64L<<16) /* Is it line-buffered? */
 
-#define SCM_PORTP(x) (SCM_NIMP(x) && (SCM_TYP7(x)==scm_tc7_port))
+#define SCM_PORTP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_port))
 #define SCM_OPPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN)))
 #define SCM_OPINPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_RDNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG)))
 #define SCM_OPOUTPORTP(x) (SCM_NIMP(x) && (((0x7f | SCM_OPN | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG)))
@@ -164,6 +164,8 @@ extern int scm_port_table_size; /* Number of ports in scm_port_table.  */
    && (((0x7f | SCM_WRTNG) & SCM_CELL_WORD_0(x))==(scm_tc7_port | SCM_WRTNG)))
 #define SCM_OPENP(x) (SCM_NIMP(x) && (SCM_OPN & SCM_CELL_WORD_0 (x)))
 #define SCM_CLOSEDP(x) (!SCM_OPENP(x))
+#define SCM_CLR_PORT_OPEN_FLAG(p) \
+  SCM_SET_CELL_WORD_0 ((p), SCM_CELL_WORD_0 (p) & ~SCM_OPN)
 
 #define SCM_PTAB_ENTRY(x)         ((scm_port *) SCM_CELL_WORD_1 (x))
 #define SCM_SETPTAB_ENTRY(x,ent)  (SCM_SET_CELL_WORD_1 ((x), (scm_bits_t) (ent)))
@@ -324,7 +326,7 @@ extern SCM scm_close_all_ports_except (SCM ports);
 
 #endif  /* SCM_DEBUG_DEPRECATED == 0 */
 
-#endif  /* PORTSH */
+#endif  /* SCM_PORTS_H */
 
 /*
   Local Variables:

diff --git a/libguile/print.c b/libguile/print.c
index 0c2adba..b1f59d2 100644 (file)
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995-1999, 2000, 2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1999,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -254,8 +254,8 @@ scm_free_print_state (SCM print_state)
   pstate->revealed = 0;
   SCM_NEWCELL (handle);
   SCM_DEFER_INTS;
-  SCM_SETCAR (handle, print_state);
-  SCM_SETCDR (handle, SCM_CDR (print_state_pool));
+  SCM_SET_CELL_WORD_0 (handle, print_state);
+  SCM_SET_CELL_WORD_1 (handle, SCM_CDR (print_state_pool));
   SCM_SETCDR (print_state_pool, handle);
   SCM_ALLOW_INTS;
 }
@@ -419,7 +419,7 @@ taloop:
                                                exp, port, pstate)))
          {
            SCM name, code, env;
-           if (SCM_TYP16 (exp) == scm_tc16_macro)
+           if (SCM_MACROP (exp))
              {
                /* Printing a macro. */
              prinmacro:
@@ -806,10 +806,11 @@ scm_ipruk (char *hdr, SCM ptr, SCM port)
   scm_putc ('>', port);
 }
 
-/* Print a list.
- */
-
 
+/* Print a list.  The list may be either a list of ordinary data, or it may be
+   a list that represents code.  Lists that represent code may contain gloc
+   cells.
+ */
 void 
 scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
 {
@@ -837,13 +838,10 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
   
   /* No cdr cycles intrinsic to this list */
   scm_iprin1 (SCM_CAR (exp), port, pstate);
-  exp = SCM_CDR (exp);
-  for (; SCM_NIMP (exp); exp = SCM_CDR (exp))
+  for (exp = SCM_CDR (exp); SCM_ECONSP (exp); exp = SCM_CDR (exp))
     {
       register int i;
 
-      if (SCM_NECONSP (exp))
-       break;
       for (i = floor; i >= 0; --i)
        if (SCM_EQ_P (pstate->ref_stack[i], exp))
          goto circref;
@@ -852,7 +850,7 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
       /* CHECK_INTS; */
       scm_iprin1 (SCM_CAR (exp), port, pstate);
     }
-  if (SCM_NNULLP (exp))
+  if (!SCM_NULLP (exp))
     {
       scm_puts (" . ", port);
       scm_iprin1 (exp, port, pstate);
@@ -869,12 +867,10 @@ fancy_printing:
     
     scm_iprin1 (SCM_CAR (exp), port, pstate);
     exp = SCM_CDR (exp); --n;
-    for (; SCM_NIMP (exp); exp = SCM_CDR (exp))
+    for (; SCM_ECONSP (exp); exp = SCM_CDR (exp))
       {
        register unsigned long i;
 
-       if (SCM_NECONSP (exp))
-         break;
        for (i = 0; i < pstate->top; ++i)
          if (SCM_EQ_P (pstate->ref_stack[i], exp))
            goto fancy_circref;

diff --git a/libguile/procs.h b/libguile/procs.h
index 3e332f0..7007b3d 100644 (file)
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -1,8 +1,8 @@
 /* classes: h_files */
 
-#ifndef PROCSH
-#define PROCSH
-/*     Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+#ifndef SCM_PROCS_H
+#define SCM_PROCS_H
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -97,8 +97,8 @@ typedef struct
 #define SCM_SETPROCPROPS(x, p) SCM_SETCDR (SCM_CLOSCAR (x), p)
 #define SCM_SETCODE(x, e) (SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (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_ENV(x) SCM_CELL_OBJECT_1 (x)
+#define SCM_SETENV(x, e) SCM_SET_CELL_OBJECT_1 ((x), (e))
 #define SCM_TOP_LEVEL(ENV)  (SCM_NULLP (ENV) || (SCM_EQ_P (scm_procedure_p (SCM_CAR (ENV)), SCM_BOOL_T)))
 
 /* Procedure-with-setter
@@ -194,7 +194,7 @@ extern SCM scm_make_cclo (SCM proc, SCM len);
 
 #endif  /* SCM_DEBUG_DEPRECATED == 0 */
 
-#endif  /* PROCSH */
+#endif  /* SCM_PROCS_H */
 
 /*
   Local Variables:

diff --git a/libguile/properties.c b/libguile/properties.c
index b333438..6d9d803 100644 (file)
--- a/libguile/properties.c
+++ b/libguile/properties.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -72,6 +72,7 @@ SCM_DEFINE (scm_primitive_make_property, "primitive-make-property", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
            (SCM prop, SCM obj),
            "Return the property @var{prop} of @var{obj}.  When no value\n"
@@ -83,22 +84,24 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
            "default value of @var{prop}.")
 #define FUNC_NAME s_scm_primitive_property_ref
 {
-  SCM h, assoc;
+  SCM h;
 
   SCM_VALIDATE_CONS (SCM_ARG1, prop);
 
   h = scm_hashq_get_handle (scm_properties_whash, obj);
-  assoc = (SCM_NIMP (h) ? scm_assq (prop, SCM_CDR (h)) : SCM_BOOL_F);
-  if (SCM_NIMP (assoc))
-    return SCM_CDR (assoc);
+  if (!SCM_FALSEP (h))
+    {
+      SCM assoc = scm_assq (prop, SCM_CDR (h));
+      if (!SCM_FALSEP (assoc))
+       return SCM_CDR (assoc);
+    }
 
   if (SCM_FALSEP (SCM_CAR (prop)))
     return SCM_BOOL_F;
   else
     {
-      SCM val = scm_apply (SCM_CAR (prop),
-                          SCM_LIST2 (prop, obj), SCM_EOL);
-      if (SCM_IMP (h))
+      SCM val = scm_apply (SCM_CAR (prop), SCM_LIST2 (prop, obj), SCM_EOL);
+      if (SCM_FALSEP (h))
        h = scm_hashq_create_handle_x (scm_properties_whash, obj, SCM_EOL);
       SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h)));
       return val;
@@ -106,6 +109,7 @@ SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
            (SCM prop, SCM obj, SCM val),
            "Associate @var{code} with @var{prop} and @var{obj}.")
@@ -126,6 +130,7 @@ SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
            (SCM prop, SCM obj),
            "Remove any value associated with @var{prop} and @var{obj}.")
@@ -134,12 +139,13 @@ SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
   SCM h;
   SCM_VALIDATE_CONS (SCM_ARG1, prop);
   h = scm_hashq_get_handle (scm_properties_whash, obj);
-  if (SCM_NIMP (h))
+  if (!SCM_FALSEP (h))
     SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop));
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
+
 void
 scm_init_properties ()
 {

diff --git a/libguile/smob.c b/libguile/smob.c
index f7d00e9..6cd557c 100644 (file)
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -88,9 +88,11 @@ scm_mark0 (SCM ptr)
 }
 
 SCM 
+/* Dirk::FIXME: The name markcdr is misleading, since the term cdr should only
+   be used for real pairs. */
 scm_markcdr (SCM ptr)
 {
-  return SCM_CDR (ptr);
+  return SCM_CELL_OBJECT_1 (ptr);
 }
 
 /* {Free}

diff --git a/libguile/tags.h b/libguile/tags.h
index 846d270..0670c16 100644 (file)
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -1,8 +1,8 @@
 /* classes: h_files */
 
-#ifndef TAGSH
-#define TAGSH
-/* Copyright (C) 1995, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
+#ifndef SCM_TAGS_H
+#define SCM_TAGS_H
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -271,10 +271,7 @@ typedef long scm_bits_t;
  * stored in the SCM_CAR of a non-immediate object have a 1 in bit 1:
  */
 
-#define SCM_SLOPPY_CONSP(x)  ((1 & SCM_CELL_TYPE (x)) == 0)
-#define SCM_SLOPPY_NCONSP(x) (!SCM_SLOPPY_CONSP(x))
-
-#define SCM_CONSP(x)  (!SCM_IMP (x) && SCM_SLOPPY_CONSP (x))
+#define SCM_CONSP(x)  (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
 #define SCM_NCONSP(x) (!SCM_CONSP (x))
 
 
@@ -283,7 +280,7 @@ typedef long scm_bits_t;
  */
 #define SCM_ECONSP(x) \
   (!SCM_IMP (x) \
-   && (SCM_SLOPPY_CONSP (x) \
+   && (SCM_CONSP (x) \
        || (SCM_TYP3 (x) == 1 \
           && (SCM_STRUCT_VTABLE_DATA (x)[scm_vtable_index_vcell] != 0))))
 #define SCM_NECONSP(x) (!SCM_ECONSP (x))
@@ -542,6 +539,9 @@ extern char *scm_isymnames[];   /* defined in print.c */
 
 #if (SCM_DEBUG_DEPRECATED == 0)
 
+#define SCM_SLOPPY_CONSP(x)  ((1 & SCM_CELL_TYPE (x)) == 0)
+#define SCM_SLOPPY_NCONSP(x) (!SCM_SLOPPY_CONSP(x))
+
 #define scm_tc7_ssymbol                scm_tc7_symbol
 #define scm_tc7_msymbol                scm_tc7_symbol
 #define scm_tcs_symbols         scm_tc7_symbol
@@ -553,7 +553,7 @@ extern char *scm_isymnames[];   /* defined in print.c */
 
 #endif  /* SCM_DEBUG_DEPRECATED == 0 */
 
-#endif  /* TAGSH */
+#endif  /* SCM_TAGS_H */
 
 /*
   Local Variables:

diff --git a/libguile/throw.c b/libguile/throw.c
index a106059..e0e921d 100644 (file)
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995, 1996, 1997, 1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -71,8 +71,10 @@ static scm_bits_t tc16_jmpbuffer;
 #define SCM_JMPBUFP(OBJ)       SCM_TYP16_PREDICATE (tc16_jmpbuffer, OBJ)
 
 #define JBACTIVE(OBJ)          (SCM_CELL_WORD_0 (OBJ) & (1L << 16L))
-#define ACTIVATEJB(OBJ)                (SCM_SETOR_CAR (OBJ, (1L << 16L)))
-#define DEACTIVATEJB(OBJ)      (SCM_SETAND_CAR (OBJ, ~(1L << 16L)))
+#define ACTIVATEJB(x)  \
+  (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) | (1L << 16L))))
+#define DEACTIVATEJB(x) \
+  (SCM_SET_CELL_WORD_0 ((x), (SCM_CELL_WORD_0 (x) & ~(1L << 16L))))
 
 #define JBJMPBUF(OBJ)           ((jmp_buf *) SCM_CELL_WORD_1 (OBJ))
 #define SETJBJMPBUF(x,v)        (SCM_SET_CELL_WORD_1 ((x), (v)))

diff --git a/libguile/variable.c b/libguile/variable.c
index 4ce7d61..064744f 100644 (file)
--- a/libguile/variable.c
+++ b/libguile/variable.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995, 1996, 1997, 1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -59,17 +59,16 @@ static int
 variable_print (SCM exp, SCM port, scm_print_state *pstate)
 {
   scm_puts ("#<variable ", port);
-  scm_intprint(SCM_UNPACK (exp), 16, port);
+  scm_intprint (SCM_UNPACK (exp), 16, port);
   {
-    SCM val_cell;
-    val_cell = SCM_CDR(exp);
-    if (!SCM_UNBNDP (SCM_CAR (val_cell)))
+    SCM vcell = SCM_VARVCELL (exp);
+    if (!SCM_UNBNDP (SCM_CAR (vcell)))
       {
        scm_puts (" name: ", port);
-       scm_iprin1 (SCM_CAR (val_cell), port, pstate);
+       scm_iprin1 (SCM_CAR (vcell), port, pstate);
       }
     scm_puts (" binding: ", port);
-    scm_iprin1 (SCM_CDR (val_cell), port, pstate);
+    scm_iprin1 (SCM_CDR (vcell), port, pstate);
   }
   scm_putc('>', port);
   return 1;
@@ -78,7 +77,7 @@ variable_print (SCM exp, SCM port, scm_print_state *pstate)
 static SCM
 variable_equalp (SCM var1, SCM var2)
 {
-  return scm_equal_p (SCM_CDR (var1), SCM_CDR (var2));
+  return scm_equal_p (SCM_VARVCELL (var1), SCM_VARVCELL (var2));
 }
 \f
 
@@ -100,17 +99,13 @@ SCM_DEFINE (scm_make_variable, "make-variable", 1, 1, 0,
             "variable may exist, so @var{name-hint} is just that---a hint.\n")
 #define FUNC_NAME s_scm_make_variable
 {
-  SCM val_cell;
+  SCM vcell;
   
   if (SCM_UNBNDP (name_hint))
     name_hint = anonymous_variable_sym;
 
-  SCM_NEWCELL(val_cell);
-  SCM_DEFER_INTS;
-  SCM_SETCAR (val_cell, name_hint);
-  SCM_SETCDR (val_cell, init);
-  SCM_ALLOW_INTS;
-  return make_vcell_variable (val_cell);
+  vcell = scm_cons (name_hint, init);
+  return make_vcell_variable (vcell);
 }
 #undef FUNC_NAME
 
@@ -129,11 +124,7 @@ SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 1, 0,
   if (SCM_UNBNDP (name_hint))
     name_hint = anonymous_variable_sym;
 
-  SCM_NEWCELL (vcell);
-  SCM_DEFER_INTS;
-  SCM_SETCAR (vcell, name_hint);
-  SCM_SETCDR (vcell, SCM_UNDEFINED);
-  SCM_ALLOW_INTS;
+  vcell = scm_cons (name_hint, SCM_UNDEFINED);
   return make_vcell_variable (vcell);
 }
 #undef FUNC_NAME
@@ -158,7 +149,7 @@ SCM_DEFINE (scm_variable_ref, "variable-ref", 1, 0, 0,
 #define FUNC_NAME s_scm_variable_ref
 {
   SCM_VALIDATE_VARIABLE (1, var);
-  return SCM_CDR (SCM_CDR (var));
+  return SCM_CDR (SCM_VARVCELL (var));
 }
 #undef FUNC_NAME
 
@@ -171,8 +162,8 @@ SCM_DEFINE (scm_variable_set_x, "variable-set!", 2, 0, 0,
            "value. Return an unspecified value.\n")
 #define FUNC_NAME s_scm_variable_set_x
 {
-  SCM_VALIDATE_VARIABLE (1,var);
-  SCM_SETCDR (SCM_CDR (var), val);
+  SCM_VALIDATE_VARIABLE (1, var);
+  SCM_SETCDR (SCM_VARVCELL (var), val);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -213,8 +204,8 @@ SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
             "Throws an error if @var{var} is not a variable object.\n")
 #define FUNC_NAME s_scm_variable_bound_p
 {
-  SCM_VALIDATE_VARIABLE (1,var);
-  return SCM_NEGATE_BOOL(SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (var))));
+  SCM_VALIDATE_VARIABLE (1, var);
+  return SCM_BOOL (!SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (var))));
 }
 #undef FUNC_NAME
 

diff --git a/libguile/variable.h b/libguile/variable.h
index 22a2e04..f5fc686 100644 (file)
--- a/libguile/variable.h
+++ b/libguile/variable.h
@@ -1,8 +1,8 @@
 /* classes: h_files */
 
-#ifndef VARIABLEH
-#define VARIABLEH
-/*     Copyright (C) 1995,1996, 2000 Free Software Foundation, Inc.
+#ifndef SCM_VARIABLE_H
+#define SCM_VARIABLE_H
+/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -55,7 +55,7 @@
  */
 extern scm_bits_t scm_tc16_variable;
 
-#define SCM_VARVCELL(V)        SCM_CDR(V)
+#define SCM_VARVCELL(V)        SCM_CELL_OBJECT_1 (V)
 #define SCM_VARIABLEP(X)       (!SCM_IMP (X) && SCM_CELL_TYPE (X) == scm_tc16_variable)
 #define SCM_UDVARIABLEP(X)     (SCM_VARIABLEP(X) && SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X))))
 #define SCM_DEFVARIABLEP(X)    (SCM_VARIABLEP(X) && !SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (X))))
@@ -71,7 +71,7 @@ extern SCM scm_builtin_variable (SCM name);
 extern SCM scm_variable_bound_p (SCM var);
 extern void scm_init_variable (void);
 
-#endif  /* VARIABLEH */
+#endif  /* SCM_VARIABLE_H */
 
 /*
   Local Variables:

diff --git a/libguile/vectors.c b/libguile/vectors.c
index bd1b7ba..280b2ee 100644 (file)
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -178,13 +178,20 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
 #define FUNC_NAME s_scm_vector
 {
   SCM res;
-  register SCM *data;
-  int i;
-  SCM_VALIDATE_LIST_COPYLEN (1,l,i);
+  SCM *data;
+  long i;
+
+  /* Dirk:FIXME:: In case of multiple threads, the list might get corrupted
+     while the vector is being created. */
+  SCM_VALIDATE_LIST_COPYLEN (1, l, i);
   res = scm_c_make_vector (i, SCM_UNSPECIFIED);
   data = SCM_VELTS (res);
-  for(; i && SCM_NIMP(l); --i, l = SCM_CDR (l))
-    *data++ = SCM_CAR (l);
+  while (!SCM_NULLP (l)) 
+    {
+      *data++ = SCM_CAR (l);
+      l = SCM_CDR (l);
+    }
+
   return res;
 }
 #undef FUNC_NAME

diff --git a/libguile/weaks.c b/libguile/weaks.c
index c01da2c..c6cf591 100644 (file)
--- a/libguile/weaks.c
+++ b/libguile/weaks.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1998, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -88,17 +88,22 @@ SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
 #define FUNC_NAME s_scm_weak_vector
 {
   SCM res;
-  register SCM *data;
+  SCM *data;
   long i;
 
+  /* Dirk:FIXME:: In case of multiple threads, the list might get corrupted
+     while the vector is being created. */
   i = scm_ilength (l);
   SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME);
   res = scm_make_weak_vector (SCM_MAKINUM (i), SCM_UNSPECIFIED);
   data = SCM_VELTS (res);
-  for (;
-       i && SCM_CONSP (l);
-       --i, l = SCM_CDR (l))
-    *data++ = SCM_CAR (l);
+
+  while (!SCM_NULLP (l))
+    {
+      *data++ = SCM_CAR (l);
+      l = SCM_CDR (l);
+    }
+
   return res;
 }
 #undef FUNC_NAME