github.com/Interlisp.maiko
1
0
Fork 0
mirror of https://github.com/Interlisp/maiko.git synced 2026-01-14 23:46:14 +00:00
Code Issues Projects Releases Wiki Activity
Interlisp.maiko/inc/cell.h

494 lines
13 KiB
C
Executable File
Raw Blame History

/* $Id: cell.h,v 1.2 1999/01/03 02:05:55 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
/************************************************************************/
/* */
/* (C) Copyright 1989-92 Venue. All Rights Reserved. */
/* Manufactured in the United States of America. */
/* */
/* The contents of this file are proprietary information */
/* belonging to Venue, and are provided to you under license. */
/* They may not be further distributed or disclosed to third */
/* parties without the specific permission of Venue. */
/* */
/************************************************************************/
/**********************************************************************/
/*
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 a pointer that points CAR cell */
/* On 68010,68000 This Macro does not effect */
#ifdef NEWCDRCODING
#define CARFIELD(x) ((int)x & 0x0fffffff)
/* CDR-Codes defs */
#define CDR_ONPAGE 8
#define CDR_NIL 8
#define CDR_INDIRECT 0
#define CDR_MAXINDIRECT 7
#define CONSPAGE_LAST 0xffffffff /* dummy "last cons page" */
#else
#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
#define CONSPAGE_LAST 0xffff
#endif /* NEWCDRCODING */
/************************************************************************/
/* */
/* CONSPAGE describes the free-space management fields at the */
/* beginning of a cons page -- # of free cells on the page, etc. */
/* */
/************************************************************************/
#ifndef BYTESWAP
#ifdef NEWCDRCODING
struct
conspage
{
/* used to be ifdef NEWNEW */
LispPTR cell6; /* cell 6 in shifted world */
LispPTR cell4; /* cell 4 in shifted world */
/* used to endif NEWNEW here */
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 /* NEWCDRCODING */
#else
/* byte-swapped version */
#ifdef NEWCDRCODING
struct
conspage
{
LispPTR cell6; /* cell 6 in shifted world */
LispPTR cell4; /* cell 4 in shifted world */
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 /* NEWCDRCODING */
#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 */
typedef struct freec
{
unsigned next_free: 8; /* next free cell on this page */
unsigned nil: 24;
} freecons;
#else
typedef struct freec
{
unsigned nil: 24;
unsigned next_free: 8;
} freecons;
#endif /* BYTESWAP */
#define FREECONS(page,offset) ((freecons *) ((DLword *)page + offset))
/************************************************************************/
/* */
/* S Y M B O L D E F S */
/* */
/* */
/* */
/************************************************************************/
#ifndef BYTESWAP
/************************************************/
/* Definitions for normal byte-order machines */
/************************************************/
#ifdef 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 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;
};
#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 */
/************************************************/
#ifdef BIGVM
/* Definition of a new-atom, where all the cells are in one object */
typedef
struct new_atom
{
unsigned pncell: 28; /* pointer to the pname itself */
unsigned dfargtype: 2 ;
unsigned dffastp: 1 ;
unsigned dfccodep: 1 ; /* DEFCELL FLAGS */
unsigned valcell: 28; /* pointer to the top-level value */
unsigned nil2: 4; /* top 4 bits of value cell */
unsigned defcell: 28; /* pointer to function definition */
unsigned nil3: 4; /* top 4 bits of definition cell */
unsigned plcell: 28; /* pointer to property list */
unsigned nil4: 4; /* */
unsigned nil5: 8; /* Fill out last byte of final cell */
unsigned plnil: 5;
unsigned plfatpnamep: 1;
unsigned plgensymp: 1;
unsigned plunused: 1; /* PROPLIST FLAGS */
unsigned dfnil: 2 ;
unsigned dfswapped: 1 ; /* T for native-order fn opcodes */
unsigned dfpseudo: 1 ;
unsigned dfnil1: 4 ; /* DEFCELL FLAGS */
unsigned pnpkg: 8; /* package */
} NewAtom;
/* DEFs for DEFINITIONCELL */
typedef
struct definition_cell
{
unsigned defpointer : 28;
unsigned argtype : 2 ;
unsigned fastp : 1 ;
unsigned ccodep : 1 ;
LispPTR nil_PL; /* skip the proplist cell */
unsigned nil_last: 18;
unsigned byteswapped : 1 ; /* T for native-order fn opcodes */
unsigned pseudocodep : 1 ;
unsigned nil2 : 4 ;
unsigned nilpkg:8; /* skip pkg byte */
} DefCell ;
typedef
struct pname_cell
{
unsigned pnamebase : 28 ;
unsigned nil : 4 ;
LispPTR nil_val;
LispPTR nil_def;
LispPTR nil_plist;
unsigned nil2: 24;
unsigned pkg_index : 8 ;
} PNCell ;
typedef
struct proplist_cell
{
unsigned propbase: 28;
unsigned nil: 4;
unsigned nil3: 8;
unsigned nil2: 5;
unsigned fatpnamep: 1;
unsigned gensymp: 1;
unsigned unused: 1;
unsigned nildef: 8;
unsigned nilpkg: 8;
} PLCell;
struct xpointer{
unsigned addr:28;
unsigned flags:4;
};
#else /* BIGVM */
/* 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 /* BIGVM */
#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 & SEGMASK) != 0) ? \
(LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_DEFN_OFFSET) \
: GetDEFCELLlitatom(index) )
#define GetVALCELL68k(index) (((index & SEGMASK) != 0) ? \
(LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_VALUE_OFFSET) \
: GetVALCELLlitatom(index))
#define GetPnameCell(index) (((index & SEGMASK) != 0) ? \
(LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_PNAME_OFFSET) \
: GetPnameCelllitatom(index))
#define GetPropCell(index) (((index & SEGMASK) != 0) ? \
(LispPTR *)(Addr68k_from_LADDR(index)+NEWATOM_PLIST_OFFSET) \
: GetPropCelllitatom(index))
/* Good only for old-style LITATOMS */
#ifdef BIGVM
#define GetDEFCELLlitatom(index)\
((LispPTR *)AtomSpace + (5*(index))+NEWATOM_DEFN_PTROFF)
#define GetVALCELLlitatom(index) \
((LispPTR *)AtomSpace + (5*(index))+NEWATOM_VALUE_PTROFF)
#define GetPnameCelllitatom(index) \
((LispPTR *)AtomSpace + (5*(index))+NEWATOM_PNAME_PTROFF)
#define GetPropCelllitatom(index) \
((LispPTR *)AtomSpace + (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); \
}
Reference in New Issue View Git Blame Copy Permalink