home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fresh Fish 4
/
FreshFish_May-June1994.bin
/
bbs
/
may94
/
util
/
edit
/
jade.lha
/
Jade
/
src
/
lisp.h
< prev
next >
Wrap
C/C++ Source or Header
|
1994-04-16
|
10KB
|
372 lines
/* lisp.h -- Data structures/objects for Lisp
Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
This file is part of Jade.
Jade 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.
Jade 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 Jade; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
#ifndef _LISP_H
#define _LISP_H
#ifndef _VALUE_H
# include "value.h"
#endif
/*
* These numbers weren't just plucked from the air, they make the blocks
* of objects fit as close as possible into powers of 2 sized blocks.
*/
#define CONSBLK_SIZE 682
#define SYMBOLBLK_SIZE 170
#define NUMBERBLK_SIZE 127
#define LPOSBLK_SIZE 170
#define OBSIZE 509
enum ValueType
{
/* Static strings are C string constants, use the macro MKSTR to make
them from a normal string constant. */
V_StaticString = 0,
V_String,
V_Number,
#define V_Char V_Number
V_Cons,
V_Vector,
V_Symbol,
V_Mark,
V_Pos,
V_Keytab,
V_Keylist,
/* SUBR with one argument, this arg is new value of variable to set the
var, or NULL to make it return the variable's value. */
V_Var,
V_Subr0,
V_Subr1,
V_Subr2,
V_Subr3,
V_Subr4,
V_Subr5,
V_SubrN,
V_SF,
V_Buffer,
#define V_TX V_Buffer
V_Window,
V_File,
V_Process
};
#define VPTR(v) (v)
#define VSTRING(v) ((String *)(v))
#define VSTR(v) (VSTRING(v)->str_Data)
#define VNUMBER(v) ((Number *)(v))
#define VNUM(v) (VNUMBER(v)->num_Data.number)
#define VCHAR(v) VNUM(v)
#define VCONS(v) ((Cons *)(v))
#define VCAR(v) (VCONS(v)->cn_Car)
#define VCDR(v) (VCONS(v)->cn_Cdr)
#define VVECT(v) ((Vector *)(v))
#define VSYM(v) ((Symbol *)(v))
#define VMARK(v) ((Mark *)(v))
#define VLPOS(v) ((LPos *)(v))
#define VPOS(v) (VLPOS(v)->lp_Data.pos)
#define VKEYTAB(v) ((Keytab *)(v))
#define VKEYLIST(v) ((Keylist *)(v))
#define VXSUBR(v) ((XSubr *)(v))
#define VSUBR(v) ((Subr *)(v))
#define VSUBR0FUN(v) (VSUBR(v)->subr_Fun.fun0)
#define VSUBR1FUN(v) (VSUBR(v)->subr_Fun.fun1)
#define VSUBR2FUN(v) (VSUBR(v)->subr_Fun.fun2)
#define VSUBR3FUN(v) (VSUBR(v)->subr_Fun.fun3)
#define VSUBR4FUN(v) (VSUBR(v)->subr_Fun.fun4)
#define VSUBR5FUN(v) (VSUBR(v)->subr_Fun.fun5)
#define VSUBRNFUN(v) (VSUBR(v)->subr_Fun.fun1)
#define VSFFUN(v) (VSUBR(v)->subr_Fun.fun1)
#define VVARFUN(v) (VSUBR(v)->subr_Fun.fun1)
#define VTX(v) ((TX *)(v))
#define VBUFFER(v) VTX(v)
#define VFILE(v) ((LFile *)(v))
#define VPROC(v) ((struct Proc *)(v))
#define VWIN(v) ((VW *)(v))
#define VOBJHDR(v) ((ObjectHdr *)(v))
#define VTYPE(v) (VOBJHDR(v)->oh_Type)
#define VTYPEP(v,t) (VTYPE(v) == (t))
#define NILP(v) ((v) == sym_nil)
#define STRINGP(v) (VTYPEP(v, V_StaticString) || VTYPEP(v, V_String))
#define NUMBERP(v) VTYPEP(v, V_Number)
#define CHARP(v) NUMBERP(v)
#define CONSP(v) VTYPEP(v, V_Cons)
#define VECTORP(v) VTYPEP(v, V_Vector)
#define SYMBOLP(v) VTYPEP(v, V_Symbol)
#define BUFFERP(v) VTYPEP(v, V_Buffer)
#define POSP(v) VTYPEP(v, V_Pos)
#define MARKP(v) VTYPEP(v, V_Mark)
#define KEYTABP(v) VTYPEP(v, V_Keytab)
#define KEYLISTP(v) VTYPEP(v, V_Keylist)
#define FILEP(v) VTYPEP(v, V_File)
#define PROCESSP(v) VTYPEP(v, V_Process)
#define WINDOWP(v) (VTYPEP(v, V_Window) && VWIN(v)->vw_Window)
#define GC_MARK_BIT 0x80
#define GC_MARK(v) (VTYPE(v) & GC_MARK_BIT)
#define GC_MARKEDP(v) (GC_MARK(v) != 0)
#define GC_SET(v) (VTYPE(v) |= GC_MARK_BIT)
#define GC_CLR(v) (VTYPE(v) &= ~GC_MARK_BIT)
#define MARKVAL(v) do { if((v) && !GC_MARKEDP(v)) markvalue(v); } while(0)
typedef struct ValClass {
/*
* compares two values, rc is similar to strcmp()
*/
int (*vc_Cmp)(VALUE val1, VALUE val2);
/*
* prints a textual representation of the object, not necessarily in
* a read'able format
*/
void (*vc_Princ)(VALUE stream, VALUE obj);
/*
* prints a textual representation of the object, if possible in
* a read'able format
*/
void (*vc_Print)(VALUE stream, VALUE obj);
/*
* this is the name of the type
*/
VALUE vc_Name;
} ValClass;
/*
* The following is an array of VALCLASS structs, the array index corresponds
* to the VTF_* numbers
*/
extern ValClass ValueClasses[];
/*
* These are also defined as functions (lower-case'd names)...
*/
#define VALUECMP(v1,v2) ValueClasses[VTYPE(v1)].vc_Cmp(v1,v2)
#define PRINCVAL(s,v) ValueClasses[VTYPE(v)].vc_Princ(s,v)
#define PRINTVAL(s,v) ValueClasses[VTYPE(v)].vc_Print(s,v)
/*
* except these which aren't
*/
#define VALNAME(v) (ValueClasses[VTYPE(v)].vc_Name)
/*
* The first byte of all Lisp objects is defined as,
* bits 0 -> 6 = type of object (ie V_*)
* bit 7 = GC mark bit (only when garbage collection is in progress).
*/
typedef struct {
u_char oh_Type;
} ObjectHdr;
typedef struct {
u_char str_Type;
u_char str_Data[0];
} String;
#define STR_SIZE(s) ((s) + 1)
/* Make a static STRING from a normal C string constant, ie,
MKSTR("foo") -> "\0foo" */
#define MKSTR(s) ((String *)("\0" s))
/* Get the beginning of the STRING struct from a (char *) */
#define STRING_HDR(s) ((String *)((char *)(s)-1))
typedef struct _Number {
u_char num_Type;
union {
long number;
struct _Number *next;
} num_Data;
} Number;
typedef struct _NumberBlk {
struct _NumberBlk *nb_Next;
Number nb_Numbers[NUMBERBLK_SIZE];
} NumberBlk;
typedef struct {
u_char cn_Type;
VALUE cn_Car;
VALUE cn_Cdr;
} Cons;
typedef struct _ConsBlk {
struct _ConsBlk *cb_Next;
Cons cb_Cons[CONSBLK_SIZE];
} ConsBlk;
typedef struct _Vector {
u_char vc_Type;
struct _Vector *vc_Next;
int vc_Size;
VALUE vc_Array[0];
} Vector;
#define VECT_SIZE(s) ((sizeof(VALUE) * (s)) + sizeof(Vector))
typedef struct _Symbol {
u_char sym_Type;
u_char sym_Flags;
struct _Symbol *sym_Next; /* next symbol in obarray bucket */
VALUE sym_Name;
VALUE sym_Value;
VALUE sym_Function;
VALUE sym_PropList;
} Symbol;
#define SF_CONSTANT 1
/* Means that the symbol's value may be in the buffer-local storage, if so
then that occurrence takes precedence. */
#define SF_BUFFER_LOCAL 2
#define SF_WIN_LOCAL 4 /* Same, but for windows. */
#define SF_DEBUG 8 /* Break on next lisp form. */
#define SF_INTERNED 16 /* Symbol has been interned. */
typedef struct _SymbolBlk {
struct _SymbolBlk *sb_Next;
Symbol sb_Symbols[SYMBOLBLK_SIZE];
} SymbolBlk;
typedef union _LPos {
struct {
u_char type;
struct POS pos;
} lp_Data;
union _LPos *lp_Next;
} LPos;
typedef struct _LPosBlk {
struct _LPosBlk *lb_Next;
LPos lb_Pos[LPOSBLK_SIZE];
} LPosBlk;
typedef struct _LFile {
u_char lf_Type;
u_char lf_Flags;
struct _LFile *lf_Next;
VALUE lf_Name;
FILE *lf_File;
} LFile;
#define LFF_DONT_CLOSE 1
typedef struct {
u_char subr_Type;
union {
VALUE (*fun0)(void);
VALUE (*fun1)(VALUE);
VALUE (*fun2)(VALUE, VALUE);
VALUE (*fun3)(VALUE, VALUE, VALUE);
VALUE (*fun4)(VALUE, VALUE, VALUE, VALUE);
VALUE (*fun5)(VALUE, VALUE, VALUE, VALUE, VALUE);
} subr_Fun;
VALUE subr_Name;
int subr_DocIndex;
} Subr;
typedef struct {
u_char subr_Type;
void *subr_Fun;
VALUE subr_Name;
int subr_DocIndex;
} XSubr;
#define LIST_1(v1) cmd_cons(v1, sym_nil)
#define LIST_2(v1,v2) cmd_cons(v1, LIST_1(v2))
#define LIST_3(v1,v2,v3) cmd_cons(v1, LIST_2(v2, v3))
#define LIST_4(v1,v2,v3,v4) cmd_cons(v1, LIST_3(v2, v3, v4))
#define LIST_5(v1,v2,v3,v4,v5) cmd_cons(v1, LIST_4(v2, v3, v4, v5))
/*
* Keeps a backtrace of all lisp functions called. NOT primitives.
*/
struct LispCall {
stru