[bpt/guile.git] / libguile / pairs.h

/* classes: h_files */

#ifndef PAIRSH
#define PAIRSH
/*	Copyright (C) 1995,1996 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.  */
\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) (~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_CARLOC(x) (&SCM_CAR (x))
#define SCM_CDRLOC(x) (&SCM_CDR (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_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))))


#ifdef GUILE_DEBUG_FREELIST
#define SCM_NEWCELL(_into) do { _into = scm_debug_newcell (); } while (0)
#else
#define SCM_NEWCELL(_into) \
	do { \
	  if (SCM_IMP(scm_freelist)) \
	     _into = scm_gc_for_newcell();\
	  else \
	    { \
	       _into = scm_freelist; \
	       scm_freelist = SCM_CDR(scm_freelist);\
	       ++scm_cells_allocated; \
	    } \
	} while(0)
#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 */
Commit	Line	Data
0f2d19dd JB	1	/* classes: h_files */
	2
	3	#ifndef PAIRSH
	4	#define PAIRSH
	5	/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
	6	*
	7	* This program is free software; you can redistribute it and/or modify
	8	* it under the terms of the GNU General Public License as published by
	9	* the Free Software Foundation; either version 2, or (at your option)
	10	* any later version.
	11	*
	12	* This program is distributed in the hope that it will be useful,
	13	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	* GNU General Public License for more details.
	16	*
	17	* You should have received a copy of the GNU General Public License
	18	* along with this software; see the file COPYING. If not, write to
82892bed JB	19	* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
82892bed JB	20	* Boston, MA 02111-1307 USA
0f2d19dd JB	21	*
	22	* As a special exception, the Free Software Foundation gives permission
	23	* for additional uses of the text contained in its release of GUILE.
	24	*
	25	* The exception is that, if you link the GUILE library with other files
	26	* to produce an executable, this does not by itself cause the
	27	* resulting executable to be covered by the GNU General Public License.
	28	* Your use of that executable is in no way restricted on account of
	29	* linking the GUILE library code into it.
	30	*
	31	* This exception does not however invalidate any other reasons why
	32	* the executable file might be covered by the GNU General Public License.
	33	*
	34	* This exception applies only to the code released by the
	35	* Free Software Foundation under the name GUILE. If you copy
	36	* code from other Free Software Foundation releases into a copy of
	37	* GUILE, as the General Public License permits, the exception does
	38	* not apply to the code that you add in this way. To avoid misleading
	39	* anyone as to the status of such modified files, you must delete
	40	* this exception notice from them.
	41	*
	42	* If you write modifications of your own for GUILE, it is your choice
	43	* whether to permit this exception to apply to your modifications.
82892bed	44	* If you do not wish that, delete this exception notice. */
0f2d19dd JB	45	\f
0f2d19dd JB	46
b4309c3c	47	#include "libguile/__scm.h"
0f2d19dd JB	48
	49	\f
	50
	51	typedef struct scm_cell
	52	{
	53	SCM car;
	54	SCM cdr;
	55	} scm_cell;
	56
	57	/* SCM_PTR_LT defines how to compare two SCM_CELLPTRs (which may not be in the
	58	* same scm_array). SCM_CELLPTR is a pointer to a cons cell which may be
	59	* compared or differenced. SCMPTR is used for stack bounds.
	60	*/
	61
	62	#if !defined(__TURBOC__) \|\| defined(__TOS__)
	63
	64	typedef scm_cell *SCM_CELLPTR;
	65	typedef SCM *SCMPTR;
	66
	67	# ifdef nosve
	68	# define SCM_PTR_MASK 0xffffffffffff
	69	# define SCM_PTR_LT(x, y) (((int)(x)&SCM_PTR_MASK) < ((int)(y)&SCM_PTR_MASK))
	70	# else
	71	# define SCM_PTR_LT(x, y) ((x) < (y))
	72	# endif /* def nosve */
	73
	74	#else /* defined(__TURBOC__) && !defined(__TOS__) */
	75
	76	# ifdef PROT386
	77	typedef scm_cell *SCM_CELLPTR;
	78	typedef SCM *SCMPTR;
	79	# define SCM_PTR_LT(x, y) (((long)(x)) < ((long)(y)))
	80	# else
	81	typedef scm_cell huge *SCM_CELLPTR;
	82	typedef SCM huge *SCMPTR;
	83	# define SCM_PTR_LT(x, y) ((x) < (y))
	84	# endif /* def PROT386 */
	85
	86	#endif /* defined(__TURBOC__) && !defined(__TOS__) */
	87
	88	#define SCM_PTR_GT(x, y) SCM_PTR_LT(y, x)
	89	#define SCM_PTR_LE(x, y) (!SCM_PTR_GT(x, y))
	90	#define SCM_PTR_GE(x, y) (!SCM_PTR_LT(x, y))
	91
0f2d19dd JB	92	#define SCM_NULLP(x) (SCM_EOL == (x))
	93	#define SCM_NNULLP(x) (SCM_EOL != (x))
	94
	95
	96	\f
	97
	98	/* Cons Pairs
	99	*/
	100
	101	#define SCM_CAR(x) (((scm_cell *)(SCM2PTR(x)))->car)
	102	#define SCM_CDR(x) (((scm_cell *)(SCM2PTR(x)))->cdr)
	103	#define SCM_GCCDR(x) (~1L & SCM_CDR(x))
24e68a57 MD	104	#define SCM_SETCAR(x, v) (SCM_CAR(x) = (SCM)(v))
	105	#define SCM_SETCDR(x, v) (SCM_CDR(x) = (SCM)(v))
	106
	107	#define SCM_CARLOC(x) (&SCM_CAR (x))
	108	#define SCM_CDRLOC(x) (&SCM_CDR (x))
	109
	110	#define SCM_SETAND_CAR(x, y) (SCM_CAR (x) &= (y))
	111	#define SCM_SETAND_CDR(x, y) (SCM_CDR (x) &= (y))
	112	#define SCM_SETOR_CAR(x, y) (SCM_CAR (x) \|= (y))
	113	#define SCM_SETOR_CDR(x, y) (SCM_CDR (x) \|= (y))
0f2d19dd JB	114
	115	#define SCM_CAAR(OBJ) SCM_CAR (SCM_CAR (OBJ))
	116	#define SCM_CDAR(OBJ) SCM_CDR (SCM_CAR (OBJ))
	117	#define SCM_CADR(OBJ) SCM_CAR (SCM_CDR (OBJ))
	118	#define SCM_CDDR(OBJ) SCM_CDR (SCM_CDR (OBJ))
	119
	120	#define SCM_CAAAR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (OBJ)))
	121	#define SCM_CDAAR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (OBJ)))
	122	#define SCM_CADAR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (OBJ)))
	123	#define SCM_CDDAR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (OBJ)))
	124	#define SCM_CAADR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (OBJ)))
	125	#define SCM_CDADR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (OBJ)))
	126	#define SCM_CADDR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (OBJ)))
	127	#define SCM_CDDDR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (OBJ)))
	128
	129	#define SCM_CAAAAR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
	130	#define SCM_CDAAAR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
	131	#define SCM_CADAAR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
	132	#define SCM_CDDAAR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
	133	#define SCM_CAADAR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
	134	#define SCM_CDADAR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
	135	#define SCM_CADDAR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
	136	#define SCM_CDDDAR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
	137	#define SCM_CAAADR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
	138	#define SCM_CDAADR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
	139	#define SCM_CADADR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
	140	#define SCM_CDDADR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
	141	#define SCM_CAADDR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (SCM_CDR (OBJ))))
	142	#define SCM_CDADDR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (SCM_CDR (OBJ))))
	143	#define SCM_CADDDR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
	144	#define SCM_CDDDDR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
	145
	146
fca7547b	147	#ifdef GUILE_DEBUG_FREELIST
25748c78	148	#define SCM_NEWCELL(_into) do { _into = scm_debug_newcell (); } while (0)
88256b2e	149	#else
0f2d19dd	150	#define SCM_NEWCELL(_into) \
25748c78	151	do { \
0f2d19dd JB	152	if (SCM_IMP(scm_freelist)) \
	153	_into = scm_gc_for_newcell();\
	154	else \
	155	{ \
	156	_into = scm_freelist; \
	157	scm_freelist = SCM_CDR(scm_freelist);\
	158	++scm_cells_allocated; \
	159	} \
25748c78	160	} while(0)
88256b2e	161	#endif
0f2d19dd JB	162
0f2d19dd JB	163	\f
1cc91f1b JB	164
	165	extern SCM scm_cons SCM_P ((SCM x, SCM y));
	166	extern SCM scm_cons2 SCM_P ((SCM w, SCM x, SCM y));
	167	extern SCM scm_pair_p SCM_P ((SCM x));
	168	extern SCM scm_set_car_x SCM_P ((SCM pair, SCM value));
	169	extern SCM scm_set_cdr_x SCM_P ((SCM pair, SCM value));
	170	extern void scm_init_pairs SCM_P ((void));
	171
0f2d19dd	172	#endif /* PAIRSH */