/*
* Copyright 1989 by Rayan S. Zachariassen, all rights reserved.
* This will be free software, but only when it is finished.
*
* LISPish memory allocation scheme with garbage collection by
* Matti Aarnio <mea@nic.funet.fi> 1996, 1999 containing ideas
* (and possible bits of code) from GNU Emacs, (C) FSF.
*/
/* #define CELLDEBUG */
/* #undef __GNUC__ // -- DEBUG STUFF! */
#include "zmalloc.h"
#ifndef _LISTUTILS_H
#define _LISTUTILS_H
extern char *dupnstr __((const char *str, const int len));
extern char *mallocstr __((const int len));
extern void freestr __((const char *str, const int slen));
/*
* A LIST is a conscell with flags 0, the list is kept under dtpr.
* A STRING is a conscell with flags !0, the string is kept under string.
* The value of a LIST is a linked list of (conscell) of either type.
* The value of a C variable must not be assumed to be either a LIST of STRING.
* NIL is a LIST with null dtpr.
*/
typedef struct _conscell {
#if SIZEOF_VOID_P == 8 /* Presuming ALPHA with distaste to shorts.. */
struct _conscell *next;
union {
struct _conscell *u_dtpr;
char *u_string;
const char *cu_string;
} u;
unsigned int flags;
unsigned int slen;
#else /* presuming 32 bit machines */
struct _conscell *next;
union {
struct _conscell *u_dtpr;
char *u_string;
const char *cu_string;
} u;
unsigned short flags;
unsigned short slen;
#endif
} conscell;
#define NEWSTRING 0x001 /* newly allocated string (free() when GC) */
#define CONSTSTRING 0x002 /* constant, mutually exclusive with above */
#define QUOTEDSTRING 0x004 /* quoted, don't apply IFS after expansion */
#define NOQUOTEIFQUOTED 0x008 /* if to be quoted, don't quote (for "$@") */
#define ELEMENT 0x010 /* result of element expansion */
#define DSW_MARKER 0x020 /* for garbage collection run.. */
#define DSW_FREEMARK 0x040 /* for gc tracking, marks already free cell */
#define _DSW_MASK 0x060
#define dtpr u.u_dtpr
#define string u.u_string
#define cstring u.cu_string
/* #undef __GNUC__ */
#if defined(__GNUC__) && !defined(PROFILING) && defined(__OPTIMIZE__)
#ifndef EXTINLINE
#define EXTINLINE extern __inline__
#endif
EXTINLINE int LIST(conscell *C) { return ((~(_DSW_MASK|ELEMENT) & (C)->flags) == 0); }
EXTINLINE int STRING(conscell *C) { return ((~(_DSW_MASK|ELEMENT) & (C)->flags) != 0); }
EXTINLINE int ISCONST(conscell *C) { return ((C)->flags & CONSTSTRING); }
EXTINLINE int ISNEW(conscell *C) { return ((C)->flags & NEWSTRING); }
EXTINLINE int ISQUOTED(conscell *C) { return ((C)->flags & QUOTEDSTRING); }
EXTINLINE int ISDONTQUOTE(conscell *C) {return ((C)->flags & NOQUOTEIFQUOTED);}
EXTINLINE int ISELEMENT(conscell *C) { return ((C)->flags & ELEMENT); }
#else /* ----- not profiling ----- */
#define LIST(C) ((~(_DSW_MASK|ELEMENT) & (C)->flags) == 0)
#define STRING(C) ((~(_DSW_MASK|ELEMENT) & (C)->flags) != 0)
#define ISCONST(C) ((C)->flags & CONSTSTRING)
#define ISNEW(C) ((C)->flags & NEWSTRING)
#define ISQUOTED(C) ((C)->flags & QUOTEDSTRING)
#define ISDONTQUOTE(C) ((C)->flags & NOQUOTEIFQUOTED)
#define ISELEMENT(C) ((C)->flags & ELEMENT)
#endif /* .... not profiling .... */
#define car(X) (X)->dtpr
#define cdr(X) (X)->next
#define caar(X) car(car(X))
#define cadr(X) car(cdr(X))
#define cdar(X) cdr(car(X))
#define cddr(X) cdr(cdr(X))
#define caaar(X) car(car(car(X)))
#define cdaar(X) cdr(car(car(X)))
#define cadar(X) car(cdr(car(X)))
#define cddar(X) cdr(cdr(car(X)))
#define grindef(T,L) (fprintf(stderr, T), s_grind(L,stderr), putc('\n', stderr))
/*
* These macros make it easier to maintain the illusion of dealing with lists.
*/
/* YOU MUST BE VERY CAREFUL ABOUT CALLING MACROS FROM WITHIN MACROS!!! */
/* BE VERY CAREFUL ABOUT USING EXPRESSIONS WITH SIDEEFFECTS INSIDE MACRO ARGS */
/* #define newcell() (conscell *)tmalloc(sizeof (conscell)) */
#ifndef newcell
extern conscell * newcell __((void));
#endif
extern conscell *s_last __((conscell *));
#if !defined(__GNUC__)
extern conscell * copycell __((conscell*X));
extern conscell * nconc __((conscell *X, conscell *Y));
extern conscell * ncons __((conscell *X));
extern conscell * cons __((conscell *X, conscell *Y));
extern conscell * s_push __((conscell *X, conscell *Y));
extern conscell * newstring __((char *s, const int slen));
extern conscell * conststring __((const char *s, const int slen));
#else /* ---- not profiling ---- */
#if defined(__GNUC__) && !defined(PROFILING) && defined(__OPTIMIZE__)
EXTINLINE conscell *copycell(conscell *X) {
conscell *tmp = newcell();
*tmp = *X;
if (STRING(tmp)) {
tmp->string = dupnstr(tmp->cstring,tmp->slen);
/* Copycell does *NOT* preserve other string flags,
caller must do that! */
tmp->flags = NEWSTRING;
}
return tmp;
}
/*
#define nconc(X,Y) (car(X) != 0 ? cdr(s_last(car(X))) = (Y) \
: (car(X) = (Y), (X)))
*/
/* nconc(list, list) -> old (,@list ,@list) */
EXTINLINE conscell * nconc(conscell *X, conscell *Y)
{
if (car(X)) {
cdr(s_last(car(X))) = Y;
return Y;
} else {
car(X) = Y;
return X;
}
}
/* ncons(s-expr) -> new (s-expr) */
EXTINLINE conscell * ncons(conscell *X)
{
conscell *tmp = newcell();
car(tmp) = X;
tmp->slen = tmp->flags = 0;
cdr(tmp) = NULL;
return tmp;
}
/* cons(s-expr, list) -> new (s-expr ,@list) */
EXTINLINE conscell *cons(conscell *X, conscell *Y)
{
conscell *tmp = ncons(X);
cdar(tmp) = Y;
return tmp;
}
/* s_push(s-expr, list) -> old (s-expr ,@list) */
EXTINLINE conscell * s_push(conscell *X, conscell *Y)
{
cdr(X) = car(Y);
car(Y) = X;
return Y;
}
EXTINLINE conscell * newstring(char *s, const int slen)
{
conscell *tmp = newcell();
tmp->string = s;
tmp->flags = NEWSTRING;
tmp->slen = slen;
cdr(tmp) = NULL;
return tmp;
}
EXTINLINE conscell * conststring(const char *cs, const int slen)
{
conscell *tmp = newcell();
tmp->cstring = cs;
tmp->flags = CONSTSTRING;
tmp->slen = slen;
cdr(tmp) = NULL;
return tmp;
}
#else /* Not optimizing; no inlines.. */
#define copycell(X) \
({conscell *_tmp = newcell(); *_tmp = *(X); \
if (STRING(_tmp)) { \
_tmp->string = dupnstr(_tmp->cstring,_tmp->slen); \
/* Copycell does *NOT* preserve other string flags, \
caller must do that! */ \
_tmp->flags = NEWSTRING; \
} _tmp;})
/* nconc(list, list) -> old (,@list ,@list) */
#if 1
#define nconc(X,Y) (car(X) != 0 ? cdr(s_last(car(X))) = (Y) \
: (car(X) = (Y), (X)))
#else
#define nconc(X,Y) \
({conscell *_tmpX = (X), *_tmpY = (Y); \
(car(_tmpX) != NULL ? cdr(s_last(car(_tmpX))) = _tmpY : \
(car(_tmpX) = _tmpY, _tmpX)); })
#endif
/* ncons(s-expr) -> new (s-expr) */
#define ncons(X) \
({conscell *_tmp = newcell(); car(_tmp) = (X); \
_tmp->slen = _tmp->flags = 0; cdr(_tmp) = NULL; _tmp;})
/* cons(s-expr, list) -> new (s-expr ,@list) */
#define cons(X,Y) \
({conscell *_tmp = ncons(X); cdar(_tmp) = (Y); _tmp;})
/* s_push(s-expr, list) -> old (s-expr ,@list) */
#define s_push(X,Y) \
({conscell *_tmpX = (X); conscell *_tmpY = (Y); \
cdr(_tmpX) = car(_tmpY); car(_tmpY) = _tmpX; _tmpY;})
#define newstring(X,SLEN) \
({conscell *_tmp = newcell(); _tmp->string = (X); \
_tmp->flags = NEWSTRING; _tmp->slen = (SLEN); \
cdr(_tmp) = NULL; _tmp;})
#define conststring(X,SLEN) \
({conscell *_tmp = newcell(); _tmp->cstring = (X); \
_tmp->flags = CONSTSTRING; _tmp->slen = (SLEN); \
cdr(_tmp) = NULL; _tmp;})
#endif
#endif /* .... not profiling .... */
#define NIL ncons(NULL)
/* listutils.c */
#ifdef MALLOC_TRACE
#ifndef s_copy_tree
extern conscell *__s_copy_tree __((conscell *, const char *, const char *));
#define s_copy_tree(l) __s_copy_tree((l), __FILE__, __LINE__)
extern conscell *__s_copy_chain __((conscell *, const char *, const char *));
#define s_copy_chain(l) __s_copy_chain((l), __FILE__, __LINE__)
#endif /* !s_copy_tree */
#else /* !MALLOC_TRACE */
extern conscell *s_copy_tree __((conscell *));
extern conscell *s_copy_chain __((conscell *));
#endif /* MALLOC_TRACE */
/* LISPic memory allocator, and other stuff.. */
extern int cons_garbage_collect __(( void ));
extern int consvar_register __(( conscell ** ));
extern void *consvar_mark __(( void ));
extern void consvar_release __(( void * ));
/***** A bunch of neat things pulled in from GNU Emacs LISP interpreter *****/
/* Structure for recording stack slots that need marking. */
/* This is a chain of structures, each of which points at
a Lisp_Object variable whose value should be marked in
garbage collection. Normally every link of the chain is
an automatic variable of a function, and its `val' points
to some argument or local variable of the function.
On exit to the function, the chain is set back to the value
it had on entry. This way, no link remains in the chain
when the stack frame containing the link disappears.
Every function that can call Feval must protect in this fashion
all Lisp_Object variables whose contents will be used again. */
struct gcpro { /* ZMailer way -- to store a bit more info in one block */
struct gcpro *next;
int nvars; /* Number of consecutive protected variables */
conscell **var[6]; /* Address of first protected variable */
void *labeladdr; /* Debug stuff... */
};
extern struct gcpro *gcprolist;
#ifdef CELLDEBUG /* while testing */
#define GCPLABPRINT(var) {fprintf(stderr,"%s:%d %s() GCPROx(" #var "= %p )\n", \
__FILE__, __LINE__, __FUNCTION__, &var);}
#define GCPLABPRINTis(var) {fprintf(stderr,"%s:%d %s() GCPROis(" #var "= %p )\n", \
__FILE__, __LINE__, __FUNCTION__, &var);}
#define GCULABPRINT(var) {fprintf(stderr,"%s:%d %s() UNGCPROx(" #var "= %p )\n", \
__FILE__, __LINE__, __FUNCTION__, &var);}
#define UNGCASSERT(var) {GCULABPRINT(var); \
if(gcprolist != &(var)) { \
fprintf(stderr, "%s:%d %s UNGCASSERT FAIL; labeladdr = %p\n", \
__FILE__, __LINE__, __FUNCTION__ /* GCCism? */, \
(var).labeladdr), \
*(long*)0 = 0; /* ZAP! */}}
#else
#define GCPLABPRINT(var) /*nothing*/
#define GCPLABPRINTis(var) /*nothing*/
#define GCULABPRINT(var) /*nothing*/
#define UNGCASSERT(var) /*no assert*/
#endif
#ifdef __GNUC__
#define LABELME(varname) ({__label__ _gc_; _gc_:; varname.labeladdr = &&_gc_;})
#else
#define LABELME(varname)
#endif
#define GCVARS1 struct gcpro gcpro1
#define GCPRO1(varname) \
{LABELME(gcpro1);GCPLABPRINT(gcpro1); \
gcpro1.next = gcprolist; gcpro1.var[0] = &varname; gcpro1.nvars = 1; \
gcprolist = &gcpro1; }
#define UNGCPRO1 {UNGCASSERT(gcpro1); gcprolist = gcpro1.next;}
#define GCPRO1STORE(storage,varname) \
{LABELME(storage gcpro1);GCPLABPRINT(storage gcpro1); \
storage gcpro1.next = gcprolist; \
storage gcpro1.var[0] = &varname; \
storage gcpro1.nvars = 1; \
gcprolist = &storage gcpro1; }
#define UNGCPROSTORE1(storage) \
{ UNGCASSERT(storage gcpro1); gcprolist = storage gcpro1.next; }
#define GCVARS2 struct gcpro gcpro2
#define GCPRO2(varname1, varname2) \
{LABELME(gcpro2);GCPLABPRINT(gcpro2); \
gcpro2.var[0] = &varname1; gcpro2.var[1] = &varname2; \
gcpro2.next = gcprolist; gcpro2.nvars = 2; \
gcprolist = &gcpro2; }
#define UNGCPRO2 {UNGCASSERT(gcpro2);gcprolist = gcpro2.next;}
#define GCPRO2STORE(storage, varname1, varname2) \
{LABELME(storage gcpro2);GCPLABPRINT(storage gcpro2); \
storage gcpro2.var[0] = &varname1; storage gcpro2.bar[1] = &varname2; \
storage gcpro2.next = gcprolist; storage gcpro2.nvars = 2; \
gcprolist = &storage gcpro2; }
#define UNGCPROSTORE2(storage) \
{ UNGCASSERT(storage gcpro2);gcprolist = storage gcpro2.next; }
#define GCVARS3 struct gcpro gcpro3
#define GCPRO3(varname1, varname2, varname3) \
{ LABELME(gcpro3); GCPLABPRINT(gcpro3); \
gcpro3.var[0] = &varname1; gcpro3.var[1] = &varname2; \
gcpro3.var[2] = &varname3; \
gcpro3.next = gcprolist; gcpro3.nvars = 3; \
gcprolist = &gcpro3; }
#define UNGCPRO3 {UNGCASSERT(gcpro3);gcprolist = gcpro3.next;}
#define GCPRO3STORE(storage, varname1, varname2, varname3) \
{LABELME(storage gcpro3);GCPLABPRINT(storage gcpro3); \
storage gcpro3.var[0] = &varname1; storage gcpro3.bar[1] = &varname2; \
storage gcpro3.var[2] = &varname3; \
storage gcpro3.next = gcprolist; storage gcpro3.nvars = 3; \
gcprolist = &storage gcpro3; }
#define UNGCPROSTORE3(storage) \
{UNGCASSERT(storage gcpro3);gcprolist = storage gcpro3.next; }
#define GCVARS4 struct gcpro gcpro4
#define GCPRO4(varname1, varname2, varname3, varname4) \
{LABELME(gcpro4);GCPLABPRINT(gcpro4); \
gcpro4.var[0] = &varname1; gcpro4.var[1] = &varname2; \
gcpro4.var[2] = &varname3; gcpro4.var[3] = &varname4; \
gcpro4.next = gcprolist; gcpro4.nvars = 4; \
gcprolist = &gcpro4; }
#define UNGCPRO4 {UNGCASSERT(gcpro4);gcprolist = gcpro4.next;}
#define GCPRO4STORE(storage, varname1, varname2, varname3, varname4) \
{LABELME(storage gcpro4);GCPLABPRINT(storage gcpro4); \
storage gcpro4.var[0] = &varname1; storage gcpro4.var[1] = &varname2; \
storage gcpro4.var[2] = &varname3; storage gcpro4.var[3] = &varname4; \
storage gcpro4.next = gcprolist; storage gcpro4.nvars = 4; \
gcprolist = &storage gcpro4; }
#define UNGCPROSTORE4(storage) \
{UNGCASSERT(storage gcpro4);gcprolist = storage gcpro4.next; }
#define GCVARS5 struct gcpro gcpro5
#define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
{LABELME(gcpro5);GCPLABPRINT(gcpro5); \
gcpro5.var[0] = &varname1; gcpro5.var[1] = &varname2; \
gcpro5.var[2] = &varname3; gcpro5.var[3] = &varname4; \
gcpro5.var[4] = &varname5; \
gcpro5.next = gcprolist; gcpro5.nvars = 5; \
gcprolist = &gcpro5; }
#define UNGCPRO5 {UNGCASSERT(gcpro5);gcprolist = gcpro5.next;}
#define GCPRO5STORE(storage, varname1, varname2, varname3, varname4, varname5) \
{LABELME(storage gcpro5);GCPLABPRINT(storage gcpro5); \
storage gcpro5.var[0] = &varname1; storage gcpro5.var[1] = &varname2; \
storage gcpro5.var[2] = &varname3; storage gcpro5.var[3] = &varname4; \
storage gcpro5.var[4] = &varname5; \
storage gcpro5.next = gcprolist; storage gcpro5.nvars = 5; \
gcprolist = &storage gcpro5; }
#define UNGCPROSTORE5(storage) \
{UNGCASSERT(storage gcpro5);gcprolist = storage gcpro5.next;}
#define GCVARS6 struct gcpro gcpro6
#define GCPRO6(varname1, varname2, varname3, varname4, varname5, varname6) \
{LABELME(gcpro6);GCPLABPRINT(gcpro6); \
gcpro6.var[0] = &varname1; gcpro6.var[1] = &varname2; \
gcpro6.var[2] = &varname3; gcpro6.var[3] = &varname4; \
gcpro6.var[4] = &varname5; gcpro6.var[5] = &varname6; \
gcpro6.next = gcprolist; gcpro6.nvars = 6; \
gcprolist = &gcpro6; }
#define UNGCPRO6 {UNGCASSERT(gcpro6);gcprolist = gcpro6.next;}
#define GCPRO6STORE(storage, varname1, varname2, varname3, varname4, varname5, varname6) \
{LABELME(storage gcpro6);GCPLABPRINT(storage gcpro6); \
storage gcpro6.var[0] = &varname1; storage gcpro6.var[1] = &varname2; \
storage gcpro6.var[2] = &varname3; storage gcpro6.var[3] = &varname4; \
storage gcpro6.var[4] = &varname5; storage gcpro6.var[5] = &varname6; \
storage gcpro6.next = gcprolist; storage gcpro6.nvars = 6; \
gcprolist = &storage gcpro6; }
#define UNGCPROSTORE6(storage) \
{UNGCASSERT(storage gcpro6);gcprolist = storage gcpro6.next;}
/* Call staticprot (&var) to protect static variable `var'. */
extern void staticprot __((conscell **));
/* Register a function yielding conscells by calling function given as param */
extern void functionprot __((void (*objectiterator)(void (*gcmarkupfunc)(conscell *))));
#endif /* _LISTUTILS_H */
syntax highlighted by Code2HTML, v. 0.9.1