/* classes: h_files */
-#ifndef PAIRSH
-#define PAIRSH
-/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
+#ifndef SCM_PAIRS_H
+#define SCM_PAIRS_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
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
-\f
-#include "libguile/__scm.h"
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
\f
-typedef struct scm_cell
-{
- SCM car;
- SCM cdr;
-} scm_cell;
-
-/* SCM_PTR_LT defines how to compare two SCM_CELLPTRs (which may not be in the
- * same scm_array). SCM_CELLPTR is a pointer to a cons cell which may be
- * compared or differenced. SCMPTR is used for stack bounds.
- */
-
-#if !defined(__TURBOC__) || defined(__TOS__)
-
-typedef scm_cell *SCM_CELLPTR;
-typedef SCM *SCMPTR;
-
-# ifdef nosve
-# define SCM_PTR_MASK 0xffffffffffff
-# define SCM_PTR_LT(x, y) (((int)(x)&SCM_PTR_MASK) < ((int)(y)&SCM_PTR_MASK))
-# else
-# define SCM_PTR_LT(x, y) ((x) < (y))
-# endif /* def nosve */
-
-#else /* defined(__TURBOC__) && !defined(__TOS__) */
-
-# ifdef PROT386
-typedef scm_cell *SCM_CELLPTR;
-typedef SCM *SCMPTR;
-# define SCM_PTR_LT(x, y) (((long)(x)) < ((long)(y)))
-# else
-typedef scm_cell huge *SCM_CELLPTR;
-typedef SCM huge *SCMPTR;
-# define SCM_PTR_LT(x, y) ((x) < (y))
-# endif /* def PROT386 */
-
-#endif /* defined(__TURBOC__) && !defined(__TOS__) */
-
-#define SCM_PTR_GT(x, y) SCM_PTR_LT(y, x)
-#define SCM_PTR_LE(x, y) (!SCM_PTR_GT(x, y))
-#define SCM_PTR_GE(x, y) (!SCM_PTR_LT(x, y))
-
-#define SCM_NULLP(x) (SCM_EOL == (x))
-#define SCM_NNULLP(x) (SCM_EOL != (x))
-
+#include "libguile/__scm.h"
\f
-/* Cons Pairs
- */
+#if (SCM_DEBUG_PAIR_ACCESSES == 1)
+# include "libguile/struct.h"
+# define SCM_VALIDATE_PAIR(cell, expr) \
+ ((!SCM_ECONSP (cell) ? scm_error_pair_access (cell), 0 : 0), (expr))
+#else
+# define SCM_VALIDATE_PAIR(cell, expr) (expr)
+#endif
-#define SCM_CAR(x) (((scm_cell *)(SCM2PTR(x)))->car)
-#define SCM_CDR(x) (((scm_cell *)(SCM2PTR(x)))->cdr)
-#define SCM_GCCDR(x) (~1L & SCM_CDR(x))
-#define SCM_SETCAR(x, v) (SCM_CAR(x) = (SCM)(v))
-#define SCM_SETCDR(x, v) (SCM_CDR(x) = (SCM)(v))
+#define SCM_NULLP(x) (SCM_EQ_P ((x), SCM_EOL))
+#define SCM_NNULLP(x) (!SCM_NULLP (x))
-#define SCM_CARLOC(x) (&SCM_CAR (x))
-#define SCM_CDRLOC(x) (&SCM_CDR (x))
+#define SCM_CAR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_0 (x)))
+#define SCM_CDR(x) (SCM_VALIDATE_PAIR (x, SCM_CELL_OBJECT_1 (x)))
-#define SCM_SETAND_CAR(x, y) (SCM_CAR (x) &= (y))
-#define SCM_SETAND_CDR(x, y) (SCM_CDR (x) &= (y))
-#define SCM_SETOR_CAR(x, y) (SCM_CAR (x) |= (y))
-#define SCM_SETOR_CDR(x, y) (SCM_CDR (x) |= (y))
+#define SCM_SETCAR(x, v) (SCM_VALIDATE_PAIR (x, SCM_SET_CELL_OBJECT_0 ((x), (v))))
+#define SCM_SETCDR(x, v) (SCM_VALIDATE_PAIR (x, SCM_SET_CELL_OBJECT_1 ((x), (v))))
#define SCM_CAAR(OBJ) SCM_CAR (SCM_CAR (OBJ))
#define SCM_CDAR(OBJ) SCM_CDR (SCM_CAR (OBJ))
#define SCM_CADDDR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
#define SCM_CDDDDR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
-
-#ifdef DEBUG_FREELIST
-#define SCM_NEWCELL(_into) (scm_debug_newcell (&_into))
-#else
-#define SCM_NEWCELL(_into) \
- { \
- if (SCM_IMP(scm_freelist)) \
- _into = scm_gc_for_newcell();\
- else \
- { \
- _into = scm_freelist; \
- scm_freelist = SCM_CDR(scm_freelist);\
- ++scm_cells_allocated; \
- } \
- }
-#endif
-
\f
-extern SCM scm_cons SCM_P ((SCM x, SCM y));
-extern SCM scm_cons2 SCM_P ((SCM w, SCM x, SCM y));
-extern SCM scm_pair_p SCM_P ((SCM x));
-extern SCM scm_set_car_x SCM_P ((SCM pair, SCM value));
-extern SCM scm_set_cdr_x SCM_P ((SCM pair, SCM value));
-extern void scm_init_pairs SCM_P ((void));
-
-#endif /* PAIRSH */
+#if (SCM_DEBUG_PAIR_ACCESSES == 1)
+extern void scm_error_pair_access (SCM);
+#endif
+extern SCM scm_cons (SCM x, SCM y);
+extern SCM scm_cons2 (SCM w, SCM x, SCM y);
+extern SCM scm_pair_p (SCM x);
+extern SCM scm_set_car_x (SCM pair, SCM value);
+extern SCM scm_set_cdr_x (SCM pair, SCM value);
+extern void scm_init_pairs (void);
+
+#endif /* SCM_PAIRS_H */
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff