-/* classes: h_files */
-
-#ifndef PAIRSH
-#define PAIRSH
-/* Copyright (C) 1995,1996, 2000 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
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
- *
- * 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. */
-
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
- gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
-
-\f
-
-#include "libguile/__scm.h"
-
-\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))
-
-
-\f
-
-/* Cons Pairs
- */
-
-#define SCM_CAR(x) (((scm_cell *) (SCM2PTR (x)))->car)
-#define SCM_CDR(x) (((scm_cell *) (SCM2PTR (x)))->cdr)
-#define SCM_GCCDR(x) SCM_PACK(~1L & SCM_UNPACK (SCM_CDR (x)))
-#define SCM_SETCAR(x, v) (SCM_CAR (x) = SCM_PACK (v))
-#define SCM_SETCDR(x, v) (SCM_CDR (x) = SCM_PACK (v))
-
-#define SCM_CARLOC(x) (&SCM_CAR (x))
-#define SCM_CDRLOC(x) (&SCM_CDR (x))
-
-#define SCM_SETAND_CAR(x, y)\
- (SCM_CAR (x) = SCM_PACK (SCM_UNPACK (SCM_CAR (x)) & (y)))
-#define SCM_SETAND_CDR(x, y)\
- (SCM_CDR (x) = SCM_PACK (SCM_UNPACK (SCM_CDR (x)) & (y)))
-#define SCM_SETOR_CAR(x, y)\
- (SCM_CAR (x) = SCM_PACK (SCM_UNPACK (SCM_CAR (x)) | (y)))
-#define SCM_SETOR_CDR(x, y)\
- (SCM_CDR (x) = SCM_PACK (SCM_UNPACK (SCM_CDR (x)) | (y)))
-
-#define SCM_CAAR(OBJ) SCM_CAR (SCM_CAR (OBJ))
-#define SCM_CDAR(OBJ) SCM_CDR (SCM_CAR (OBJ))
-#define SCM_CADR(OBJ) SCM_CAR (SCM_CDR (OBJ))
-#define SCM_CDDR(OBJ) SCM_CDR (SCM_CDR (OBJ))
-
-#define SCM_CAAAR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (OBJ)))
-#define SCM_CDAAR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (OBJ)))
-#define SCM_CADAR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (OBJ)))
-#define SCM_CDDAR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (OBJ)))
-#define SCM_CAADR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (OBJ)))
-#define SCM_CDADR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (OBJ)))
-#define SCM_CADDR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (OBJ)))
-#define SCM_CDDDR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (OBJ)))
-
-#define SCM_CAAAAR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
-#define SCM_CDAAAR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
-#define SCM_CADAAR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
-#define SCM_CDDAAR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
-#define SCM_CAADAR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
-#define SCM_CDADAR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
-#define SCM_CADDAR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
-#define SCM_CDDDAR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
-#define SCM_CAAADR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
-#define SCM_CDAADR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
-#define SCM_CADADR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
-#define SCM_CDDADR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
-#define SCM_CAADDR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (SCM_CDR (OBJ))))
-#define SCM_CDADDR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (SCM_CDR (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))))
-
-/* Multi-cells
- */
-
-#define SCM_CELL_WORD(x, n) (((SCM *) (SCM2PTR (x)))[n])
-#define SCM_SET_CELL_WORD(x, n, v) (SCM_CELL_WORD (x, n) = (SCM) (v))
-#define SCM_CELL_WORD_LOC(x, n) (&SCM_CELL_WORD (x, n))
-
-#define SCM_CELL_WORD0(x) SCM_CELL_WORD (x, 0)
-#define SCM_CELL_WORD1(x) SCM_CELL_WORD (x, 1)
-#define SCM_CELL_WORD2(x) SCM_CELL_WORD (x, 2)
-#define SCM_CELL_WORD3(x) SCM_CELL_WORD (x, 3)
-
-#define SCM_SET_CELL_WORD0(x, v) SCM_SET_CELL_WORD(x, 0, v)
-#define SCM_SET_CELL_WORD1(x, v) SCM_SET_CELL_WORD(x, 1, v)
-#define SCM_SET_CELL_WORD2(x, v) SCM_SET_CELL_WORD(x, 2, v)
-#define SCM_SET_CELL_WORD3(x, v) SCM_SET_CELL_WORD(x, 3, v)
-
-/* the allocated thing: The car of newcells are set to
- scm_tc16_allocated to avoid the fragile state of newcells wrt the
- gc. If it stays as a freecell, any allocation afterwards could
- cause the cell to go back on the freelist, which will bite you
- sometime afterwards */
-
-#ifdef GUILE_DEBUG_FREELIST
-#define SCM_NEWCELL(_into) do { _into = scm_debug_newcell (); } while (0)
-#define SCM_NEWCELL2(_into) do { _into = scm_debug_newcell2 (); } while (0)
-#else
-#ifdef GUILE_NEW_GC_SCHEME
-/* When we introduce POSIX threads support, every thread will have
- a freelist of its own. Then it won't any longer be necessary to
- initialize cells with scm_tc16_allocated. */
-#define SCM_NEWCELL(_into) \
- do { \
- if (SCM_IMP (scm_freelist)) \
- _into = scm_gc_for_newcell (&scm_master_freelist, \
- &scm_freelist); \
- else \
- { \
- _into = scm_freelist; \
- scm_freelist = SCM_CDR (scm_freelist);\
- SCM_SETCAR (_into, scm_tc16_allocated); \
- } \
- } while(0)
-#define SCM_NEWCELL2(_into) \
- do { \
- if (SCM_IMP (scm_freelist2)) \
- _into = scm_gc_for_newcell (&scm_master_freelist2, \
- &scm_freelist2); \
- else \
- { \
- _into = scm_freelist2; \
- scm_freelist2 = SCM_CDR (scm_freelist2);\
- SCM_SETCAR (_into, scm_tc16_allocated); \
- } \
- } while(0)
-#else /* GUILE_NEW_GC_SCHEME */
-#define SCM_NEWCELL(_into) \
- do { \
- if (SCM_IMP (scm_freelist.cells)) \
- _into = scm_gc_for_newcell (&scm_freelist);\
- else \
- { \
- _into = scm_freelist.cells; \
- scm_freelist.cells = SCM_CDR (scm_freelist.cells);\
- SCM_SETCAR (_into, scm_tc16_allocated); \
- ++scm_cells_allocated; \
- } \
- } while(0)
-#define SCM_NEWCELL2(_into) \
- do { \
- if (SCM_IMP (scm_freelist2.cells)) \
- _into = scm_gc_for_newcell (&scm_freelist2);\
- else \
- { \
- _into = scm_freelist2.cells; \
- scm_freelist2.cells = SCM_CDR (scm_freelist2.cells);\
- SCM_SETCAR (_into, scm_tc16_allocated); \
- scm_cells_allocated += 2; \
- } \
- } while(0)
-#endif /* GUILE_NEW_GC_SCHEME */
-#endif
-
-\f
-
-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 /* PAIRSH */
+/* classes: h_files */
+
+#ifndef SCM_PAIRS_H
+#define SCM_PAIRS_H
+
+/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+\f
+
+#include "libguile/__scm.h"
+
+\f
+
+#if (SCM_DEBUG_PAIR_ACCESSES == 1)
+# define SCM_VALIDATE_PAIR(cell, expr) \
+ ((!scm_is_pair (cell) ? scm_error_pair_access (cell), 0 : 0), (expr))
+#else
+# define SCM_VALIDATE_PAIR(cell, expr) (expr)
+#endif
+
+/*
+ * Use scm_is_null_and_not_nil if it's important (for correctness)
+ * that #nil must NOT be considered null.
+ */
+#define scm_is_null_and_not_nil(x) (scm_is_eq ((x), SCM_EOL))
+
+/*
+ * Use scm_is_null_assume_not_nil if
+#nil will never be tested,
+ * for increased efficiency.
+ */
+#define scm_is_null_assume_not_nil(x) (scm_is_eq ((x), SCM_EOL))
+
+/*
+ * See the comments preceeding the definitions of SCM_BOOL_F and
+ * SCM_MATCHES_BITS_IN_COMMON in tags.h for more information on
+ * how the following macro works.
+ */
+#define scm_is_null_or_nil(x) \
+ (SCM_MATCHES_BITS_IN_COMMON ((x), SCM_ELISP_NIL, SCM_EOL))
+
+
+\f
+
+/* Older spellings for these null, nil, and pair predicates. */
+#define SCM_NILP(x) (scm_is_eq ((x), SCM_ELISP_NIL))
+#define SCM_NULL_OR_NIL_P(x) (scm_is_null_or_nil (x))
+#define SCM_NULLP(x) (scm_is_null (x))
+#define SCM_NNULLP(x) (!scm_is_null (x))
+#define SCM_CONSP(x) (scm_is_pair (x))
+#define SCM_NCONSP(x) (!SCM_CONSP (x))
+
+
+\f
+
+/* #nil is null. */
+#define scm_is_null(x) (scm_is_null_or_nil(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_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_CADR(OBJ) SCM_CAR (SCM_CDR (OBJ))
+#define SCM_CDDR(OBJ) SCM_CDR (SCM_CDR (OBJ))
+
+#define SCM_CAAAR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (OBJ)))
+#define SCM_CDAAR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (OBJ)))
+#define SCM_CADAR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (OBJ)))
+#define SCM_CDDAR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (OBJ)))
+#define SCM_CAADR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (OBJ)))
+#define SCM_CDADR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (OBJ)))
+#define SCM_CADDR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (OBJ)))
+#define SCM_CDDDR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (OBJ)))
+
+#define SCM_CAAAAR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
+#define SCM_CDAAAR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
+#define SCM_CADAAR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
+#define SCM_CDDAAR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
+#define SCM_CAADAR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
+#define SCM_CDADAR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
+#define SCM_CADDAR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
+#define SCM_CDDDAR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
+#define SCM_CAAADR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
+#define SCM_CDAADR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
+#define SCM_CADADR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
+#define SCM_CDDADR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
+#define SCM_CAADDR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (SCM_CDR (OBJ))))
+#define SCM_CDADDR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (SCM_CDR (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))))
+
+\f
+
+#if (SCM_DEBUG_PAIR_ACCESSES == 1)
+SCM_API void scm_error_pair_access (SCM);
+#endif
+
+SCM_API SCM scm_cons (SCM x, SCM y);
+SCM_API SCM scm_cons2 (SCM w, SCM x, SCM y);
+SCM_API SCM scm_pair_p (SCM x);
+SCM_API SCM scm_car (SCM x);
+SCM_API SCM scm_cdr (SCM x);
+SCM_API SCM scm_set_car_x (SCM pair, SCM value);
+SCM_API SCM scm_set_cdr_x (SCM pair, SCM value);
+
+SCM_API SCM scm_cddr (SCM x);
+SCM_API SCM scm_cdar (SCM x);
+SCM_API SCM scm_cadr (SCM x);
+SCM_API SCM scm_caar (SCM x);
+SCM_API SCM scm_cdddr (SCM x);
+SCM_API SCM scm_cddar (SCM x);
+SCM_API SCM scm_cdadr (SCM x);
+SCM_API SCM scm_cdaar (SCM x);
+SCM_API SCM scm_caddr (SCM x);
+SCM_API SCM scm_cadar (SCM x);
+SCM_API SCM scm_caadr (SCM x);
+SCM_API SCM scm_caaar (SCM x);
+SCM_API SCM scm_cddddr (SCM x);
+SCM_API SCM scm_cdddar (SCM x);
+SCM_API SCM scm_cddadr (SCM x);
+SCM_API SCM scm_cddaar (SCM x);
+SCM_API SCM scm_cdaddr (SCM x);
+SCM_API SCM scm_cdadar (SCM x);
+SCM_API SCM scm_cdaadr (SCM x);
+SCM_API SCM scm_cdaaar (SCM x);
+SCM_API SCM scm_cadddr (SCM x);
+SCM_API SCM scm_caddar (SCM x);
+SCM_API SCM scm_cadadr (SCM x);
+SCM_API SCM scm_cadaar (SCM x);
+SCM_API SCM scm_caaddr (SCM x);
+SCM_API SCM scm_caadar (SCM x);
+SCM_API SCM scm_caaadr (SCM x);
+SCM_API SCM scm_caaaar (SCM x);
+
+SCM_INTERNAL void scm_init_pairs (void);
+
+#endif /* SCM_PAIRS_H */
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff