Interlisp.maiko/inc/cell.h%

/* %Z% %M% Version %I% (%G%). copyright Venue   */



/************************************************************************/
/*									*/
/*	(C) Copyright 1989-92 Venue. All Rights Reserved.		*/
/*	Manufactured in the United States of America.			*/
/*									*/
/************************************************************************/


/**********************************************************************/
/*
		File Name :	cell.h

		Cell Manipulate Macros

				Date :		December 16, 1986
				Edited by :	Takeshi Shimizu

*/
/**********************************************************************/

/*  CONS CELL (LISTP) definitions moved to lispemulater.h */

  /* This Macro may produce the CDR code */
#define  CDRCODE(x)     LRSH (((int)x & 0x0ff000000) , 24)

  /* This Macro may produce a pointer that points CAR cell */
  /* On 68010,68000 This Macro does not effect *
#define  CARFIELD(x)    ((int)x & 0x00ffffff)

/* CDR-Codes defs */
#define CDR_ONPAGE		128
#define CDR_NIL			128
#define CDR_INDIRECT		0
#define CDR_MAXINDIRECT	127

/* short  CarCdrError ; */


/************************************************************************/
/*									*/
/*	CONSPAGE describes the free-space management fields at the	*/
/*	beginning of a cons page -- # of free cells on the page, etc.	*/
/*									*/
/************************************************************************/

#ifndef BYTESWAP
#ifdef NEWCDRCODE
struct
  conspage
    {
      unsigned count: 8;	/* free cells on this page */
      unsigned next_cell: 8;	/* next free cell in chain */
      unsigned nil:16;
      LispPTR  next_page;	/* next cons page, or 0 if none */
    };
#else
struct
  conspage
    {
      unsigned    count : 8   ;
      unsigned    next_cell :8 ;
      DLword  next_page ;
    };
#endif /* NEWCDRCODE */
#else
/* byte-swapped version */
#ifdef NEWCDRCODE
struct
  conspage
    {
      unsigned nil: 16;
      unsigned next_cell: 8;
      unsigned count: 8;
      LispPTR  next_page;
    };
#else
struct
  conspage
    {
      DLword  next_page ;
      unsigned    next_cell :8 ;
      unsigned    count : 8   ;
    };
#endif /* NEWCDRCODE */
#endif /* BYTESWAP */


/* Following MACROs for Conspage */

/* lisp_ptr is LISP pointer, returns 68k ptr points struct conspage obj */
#define Get_ConsPageBase(lisp_ptr)				\
  (struct conspage *)Addr68k_from_LPAGE(POINTER_PAGEBASE(lisp_ptr))

#define GetNewCell_68k(conspage68k)				\
    (ConsCell *)(((DLword *)(conspage68k))			\
  + (unsigned)((conspage68k)->next_cell) )

/* page : LISP page */
#define GetCONSCount(page)					\
  (((struct conspage *)Addr68k_from_LPAGE(page))->count)


#ifndef BYTESWAP
  /* For chaining together free cons cells on a page */
struct freecons
  {
    unsigned next_free: 8;	/* next free cell on this page */
    unsigned nil: 24;
  }

#else

struct freecons
  {
    unsigned next_free: 8;
    unsigned nil: 24;
  }

#endif /* BYTESWAP */


#ifndef BYTESWAP
	/************************************************/
	/*  Definitions for normal byte-order machines	*/
	/************************************************/

#ifdef BIGVM2
/* Definition of a new-atom, where all the cells are in one object */
typedef
  struct new_atom
      {
	unsigned dfccodep: 1 ;	/* DEFCELL FLAGS */
	unsigned dffastp: 1 ;
	unsigned dfargtype: 2 ;
	unsigned pncell: 28;	/* pointer to the pname itself */
	unsigned nil2: 4;	/* top 4 bits of value cell */
	unsigned valcell: 28;	/* pointer to the top-level value */
	unsigned nil3: 4;	/* top 4 bits of definition cell */
	unsigned defcell: 28;	/* pointer to function definition */
	unsigned nil4: 4;	/* */
	unsigned plcell: 28;	/* pointer to property list */
	unsigned pnpkg: 8;	/* package */
	unsigned dfnil1: 4 ;	/* DEFCELL FLAGS */
	unsigned dfpseudo: 1 ;
	unsigned dfswapped: 1 ;	/* T for native-order fn opcodes */
	unsigned dfnil:	2 ;
	unsigned plunused: 1;	/* PROPLIST FLAGS */
	unsigned plgensymp: 1;
	unsigned plfatpnamep: 1;
	unsigned plnil: 5;
	unsigned nil5: 8;	/* Fill out last byte of final cell */
      } NewAtom;

/* DEFs for DEFINITIONCELL */
typedef
  struct definition_cell
    {
      unsigned	ccodep	:	1 ;
      unsigned	fastp	:	1 ;
      unsigned	argtype	:	2 ;
      unsigned	defpointer :	28;
	LispPTR nil_PL;	/* skip the proplist cell */
	unsigned nilpkg:8;	/* skip pkg byte */
      unsigned	nil2	:	4 ;
      unsigned	pseudocodep :	1 ;
      unsigned	byteswapped :	1 ;	/* T for native-order fn opcodes */
	unsigned nil_last: 18;

    } DefCell ;

typedef
  struct pname_cell
    {
      unsigned	nil	:	4 ;
      unsigned	pnamebase : 28 ;
	LispPTR nil_val;
	LispPTR nil_def;
	LispPTR nil_plist;
      unsigned	pkg_index : 8 ;
	unsigned nil2: 24;
    } PNCell ;

typedef
  struct proplist_cell
    {
      unsigned nil: 4;
      unsigned propbase: 28;
	unsigned nilpkg: 8;
	unsigned nildef: 8;
      unsigned unused: 1;
      unsigned gensymp: 1;
      unsigned fatpnamep: 1;
      unsigned nil2: 5;
	unsigned nil3:	8;

    } PLCell;


struct xpointer{
	unsigned	flags:4;
	unsigned	addr:28;
};

#elif BIGVM
/* Definition of a new-atom, where all the cells are in one object */
typedef
  struct new_atom
      {
	unsigned dfccodep: 1 ;	/* DEFCELL FLAGS */
	unsigned dffastp: 1 ;
	unsigned dfargtype: 2 ;
	unsigned nil1:4;
	unsigned pncell: 24;	/* pointer to the pname itself */
	unsigned nil2: 8;	/* top 4 bits of value cell */
	unsigned valcell: 24;	/* pointer to the top-level value */
	unsigned nil3: 8;	/* top 4 bits of definition cell */
	unsigned defcell: 24;	/* pointer to function definition */
	unsigned nil4: 8;	/* */
	unsigned plcell: 24;	/* pointer to property list */
	unsigned pnpkg: 8;	/* package */
	unsigned dfnil1: 4 ;	/* DEFCELL FLAGS */
	unsigned dfpseudo: 1 ;
	unsigned dfswapped: 1 ;	/* T for native-order fn opcodes */
	unsigned dfnil:	2 ;
	unsigned plunused: 1;	/* PROPLIST FLAGS */
	unsigned plgensymp: 1;
	unsigned plfatpnamep: 1;
	unsigned plnil: 5;
	unsigned nil5: 8;	/* Fill out last byte of final cell */
      } NewAtom;

/* DEFs for DEFINITIONCELL */
typedef
  struct definition_cell
    {
      unsigned	ccodep	:	1 ;
      unsigned	fastp	:	1 ;
      unsigned	argtype	:	2 ;
	  unsigned nil1:4;
      unsigned	defpointer :	24;
	LispPTR nil_PL;	/* skip the proplist cell */
	unsigned nilpkg:8;	/* skip pkg byte */
      unsigned	nil2	:	4 ;
      unsigned	pseudocodep :	1 ;
      unsigned	byteswapped :	1 ;	/* T for native-order fn opcodes */
	unsigned nil_last: 18;

    } DefCell ;

typedef
  struct pname_cell
    {
      unsigned	nil	:	8 ;
      unsigned	pnamebase : 24 ;
	LispPTR nil_val;
	LispPTR nil_def;
	LispPTR nil_plist;
      unsigned	pkg_index : 8 ;
	unsigned nil2: 24;
    } PNCell ;

typedef
  struct proplist_cell
    {
      unsigned nil: 8;
      unsigned propbase: 24;
	unsigned nilpkg: 8;
	unsigned nildef: 8;
      unsigned unused: 1;
      unsigned gensymp: 1;
      unsigned fatpnamep: 1;
      unsigned nil2: 5;
	unsigned nil3:	8;

    } PLCell;


struct xpointer{
	unsigned	flags:8;
	unsigned	addr:24;
};

#else	/* not BIGVM */

/* DEFs for DEFINITIONCELL */
typedef
  struct definition_cell
    {
      unsigned	ccodep	:	1 ;
      unsigned	fastp	:	1 ;
      unsigned	argtype	:	2 ;
      unsigned	pseudocodep :	1 ;
      unsigned	byteswapped :	1 ;	/* T for native-order fn opcodes */
      unsigned	nil	:	2 ;
      unsigned	defpointer :	24;

    } DefCell ;

typedef
  struct pname_cell
    {
      unsigned	pkg_index : 8 ;
      unsigned	pnamebase : 24 ;
    } PNCell ;

typedef
  struct proplist_cell
    {
      unsigned unused: 1;
      unsigned gensymp: 1;
      unsigned fatpnamep: 1;
      unsigned nil: 5;
      unsigned propbase: 24;
    } PLCell;


struct xpointer{
	unsigned	flags:8;
	unsigned	addr:24;
};

#endif /* BIGVM */

#else
	/************************************************/
	/*  Definitions for byte-swapped machines	*/
	/************************************************/
/* DEFs for DEFINITIONCELL */
typedef
  struct definition_cell
    {
      unsigned	defpointer :	24;
      unsigned	nil	:	2 ;
      unsigned	byteswapped : 	1 ;	/* T if opcodes are native-order */
      unsigned	pseudocodep :	1 ;
      unsigned	argtype	:	2 ;
      unsigned	fastp	:	1 ;
      unsigned	ccodep	:	1 ;

    } DefCell ;

typedef
  struct pname_cell
    {
      unsigned	pnamebase : 24 ;
      unsigned	pkg_index : 8 ;
    } PNCell ;

typedef
  struct proplist_cell
    {
       unsigned propbase: 24;
      unsigned nil: 5;
      unsigned fatpnamep: 1;
      unsigned gensymp: 1;
     unsigned unused: 1;
    } PLCell;

struct xpointer
  {
    unsigned	addr:24;
    unsigned	flags:8;
  };


#endif /* BYTESWAP */




struct
  cadr_cell
    {
      LispPTR car_cell;	/* Lisp address (word addressing) */
      LispPTR cdr_cell;	/* Lisp address (word addressing) */
    };



/************************************************************************/
/*									*/
/*	Access to the parts of a SYMBOL: Pname, Definition, Value, 	*/
/*	and property list.						*/
/*									*/
/*									*/
/*									*/
/*									*/
/************************************************************************/

#ifndef BIGATOMS
#define GetDEFCELL68k(index)	((LispPTR *)Defspace + (index) )
#define GetVALCELL68k(index)	((LispPTR *)Valspace + (index))
#define GetPnameCell(index)	((LispPTR *)Pnamespace + (index))
#define GetPropCell(index)	((LispPTR *)Plistspace + (index))

  /* Good only for old-style LITATOMS */
#define GetDEFCELLlitatom(index)	((LispPTR *)Defspace + (index) )
#define GetVALCELLlitatom(index)	((LispPTR *)Valspace + (index))
#define GetPnameCelllitatom(index)	((LispPTR *)Pnamespace + (index))
#define GetPropCelllitatom(index)	((LispPTR *)Plistspace + (index))

#else
  /* Good for old LITATOMS and new NEW-ATOMs */
#define GetDEFCELL68k(index)	(((index & 0xFF0000) != 0)	?	   \
				  (LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_DEFN_OFFSET) \
				: GetDEFCELLlitatom(index) )

#define GetVALCELL68k(index)	(((index & 0xFF0000) != 0)	?	    \
				  (LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_VALUE_OFFSET) \
				: GetVALCELLlitatom(index))

#define GetPnameCell(index)	(((index & 0xFF0000) != 0)	?	   \
				  (LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_PNAME_OFFSET) \
				: GetPnameCelllitatom(index))

#define GetPropCell(index)	(((index & 0xFF0000) != 0)	?	   \
				  (LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_PLIST_OFFSET) \
				: GetPropCelllitatom(index))

  /* Good only for old-style LITATOMS */
#ifdef BIGVM
#define GetDEFCELLlitatom(index)\
	((LispPTR *)Pnamespace + (5*(index))+NEWATOM_DEFN_PTROFF)
#define GetVALCELLlitatom(index)	\
	((LispPTR *)Pnamespace + (5*(index))+NEWATOM_VALUE_PTROFF)
#define GetPnameCelllitatom(index)	\
	((LispPTR *)Pnamespace + (5*(index))+NEWATOM_PNAME_PTROFF)
#define GetPropCelllitatom(index)	\
	((LispPTR *)Pnamespace + (5*(index))+NEWATOM_PLIST_PTROFF)
#else /* BIGVM not set, so use old name-space format */
#define GetDEFCELLlitatom(index)	((LispPTR *)Defspace + (index) )
#define GetVALCELLlitatom(index)	((LispPTR *)Valspace + (index))
#define GetPnameCelllitatom(index)	((LispPTR *)Pnamespace + (index))
#define GetPropCelllitatom(index)	((LispPTR *)Plistspace + (index))
#endif

  /* Good only for new-style NEW-ATOMs */
#define GetDEFCELLnew(index) (LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_DEFN_OFFSET)
#define GetVALCELLnew(index) (LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_VALUE_OFFSET)
#define GetPnameCellnew(index) (LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_PNAME_OFFSET)
#define GetPropCellnew(index) (LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_PLIST_OFFSET)

#endif /* BIGATOMS */




/* When cadr() function is called, type check should be done. */

#define	S_N_CHECKANDCADR(sour, dest, tos)			\
		{register LispPTR parm = sour;			\
		 if(GetTypeNumber(parm) != TYPE_LISTP){		\
			ERROR_EXIT(tos);			\
		}else						\
			dest = cadr(parm);			\
		}