home *** CD-ROM | disk | FTP | other *** search
- /* 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_DynamicString,
- V_Number,
- #define V_Char V_Number
- V_Cons,
- V_Vector,
- V_Symbol,
- V_Mark,
- V_Pos,
- /* 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,
- V_GlyphTable,
- V_Void
- };
-
- #define VAL(x) ((VALUE)(x))
- #define VPTR(v) (v)
- #define VSTRING(v) ((String *)(v))
- #define VSTR(v) (&VSTRING(v)->str_Mem[1])
- #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 VVECTI(v,i) (VVECT(v)->vc_Array[(i)])
- #define VSYM(v) ((Symbol *)(v))
- #define VMARK(v) ((Mark *)(v))
- #define VLPOS(v) ((LPos *)(v))
- #define VPOS(v) (VLPOS(v)->lp_Data.pos)
- #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 VGLYPHTAB(v) ((GlyphTable *)(v))
-
- #define VTYPE(v) ((v)->type)
- #define VTYPEP(v,t) (VTYPE(v) == (t))
- #define NILP(v) ((v) == sym_nil)
- #define STRINGP(v) (VTYPEP(v, V_StaticString) || VTYPEP(v, V_DynamicString))
- #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 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 GLYPHTABP(v) VTYPEP(v, V_GlyphTable)
- #define VOIDP(v) VTYPEP(v, V_Void)
-
- #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)) mark_value(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 VALUE_CMP(v1,v2) ValueClasses[VTYPE(v1)].vc_Cmp(v1,v2)
- #define PRINC_VAL(s,v) ValueClasses[VTYPE(v)].vc_Princ(s,v)
- #define PRINT_VAL(s,v) ValueClasses[VTYPE(v)].vc_Print(s,v)
-
- /* ...except these which aren't. */
- #define VALNAME(v) (ValueClasses[VTYPE(v)].vc_Name)
-
-
- /* String data types. the `String' type is what a VALUE points to, if
- the string is dynamic it gets a length field in the word before the
- String struct proper. */
- typedef struct {
- /* str_Mem[0] is type, str_Mem[1->N] is data. */
- u_char str_Mem[1];
- } String;
-
- typedef struct {
- int ds_Length;
- u_char ds_Mem[1];
- } DynamicString;
- #define DSTR_SIZE(s) (sizeof(int) + 1 + (s))
-
- /* Get the beginning of a DynamicString from a String. */
- #define DSTRING_HDR(s) ((DynamicString *)(((char *)(s)) - sizeof(int)))
-
- /* Make a static string from a normal C string constant, ie,
- MKSTR("foo") -> "\0foo" */
- #define MKSTR(s) (VAL(("\0" s)))
-
- /* Get the beginning of the String struct from a (char *) */
- #define STRING_HDR(s) ((String *)(((char *)(s))-1))
-
- /* Find the length of this String. */
- #define STRING_LEN(s) \
- (VTYPEP(s, V_DynamicString) ? (DSTRING_HDR(s)->ds_Length) : strlen(VSTR(s)))
-
- /* True if this string may be written to; generally V_StaticString types
- are made from C string-constants and usually in read-only storage. */
- #define STRING_WRITEABLE_P(s) (!VTYPEP(s, V_StaticString))
-
-
- /* Number type. Generally a 32-bit signed integer. */
- 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;
-
-
- /* Cons-cell, a pair of VALUEs, used amongst other things to construct
- singly-linked lists (chained through the cdr, last pointer is nil). */
- 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;
-
-
- /* Vector of VALUEs. */
- 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))
-
-
- /* Symbol object, each symbol has 4 basic attributes, a name, its value
- as a variable, its value as a function and a property-list.
- Symbols are generally stored in hash tables (obarray) with collisions
- chained from the `sym_Next' field. */
- typedef struct _Symbol {
- u_char sym_Type;
- u_char sym_Flags;
- VALUE 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
- /* This means that setting the value of the symbol always sets the
- buffer-local value, even if one doesn't already exist. */
- #define SF_SET_BUFFER_LOCAL 4
- #define SF_DEBUG 8 /* Break on next lisp form. */
-
- typedef struct _SymbolBlk {
- struct _SymbolBlk *sb_Next;
- Symbol sb_Symbols[SYMBOLBLK_SIZE];
- } SymbolBlk;
-
-
- /* Lisp version of the POS structure. */
- 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;
-
-
- /* A file object. */
- 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
-
-
- /* C subroutine, can take from zero to five arguments. */
- 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;
- VALUE subr_IntSpec;
- } Subr;
-
- typedef struct {
- u_char subr_Type;
- void *subr_Fun;
- VALUE subr_Name;
- int subr_DocIndex;
- VALUE subr_IntSpec;
- } 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 {
- struct LispCall *lc_Next;
- VALUE lc_Fun;
- VALUE lc_Args;
- /* t if `lc_Args' is list of *evalled* arguments. */
- VALUE lc_ArgsEvalledP;
- };
-
-
- /* A stack of these providing additional entry points for the mark phase of
- garbage collection. */
- typedef struct _GCVAL {
- VALUE *gcv_Value;
- struct _GCVAL *gcv_Next;
- } GCVAL;
-
- typedef struct _GCVALN {
- VALUE *gcv_First;
- int gcv_N;
- struct _GCVALN *gcv_Next;
- } GCVALN;
-
- #define POPGC (gcv_stack = gcv_stack->gcv_Next)
- #define PUSHGC(gcv, val) \
- do { \
- (gcv).gcv_Value = &(val); \
- (gcv).gcv_Next = gcv_stack; \
- gcv_stack = &(gcv); \
- } while(0)
-
- #define POPGCN (gcvn_stack = gcvn_stack->gcv_Next)
- #define PUSHGCN(gcv, valp, n) \
- do { \
- (gcv).gcv_First = (valp); \
- (gcv).gcv_N = (n); \
- (gcv).gcv_Next = gcvn_stack; \
- gcvn_stack = &(gcv); \
- } while(0)
-
-
- /* Macros for defining functions and their SUBR structures. */
- #define DEFUN(name,fsym,ssym,args,type,docindex) \
- XSubr ssym = { type, fsym, MKSTR(name), docindex, NULL }; \
- VALUE fsym args
-
- /* Same as above but with an extra arg -- an interactive-spec string. */
- #define DEFUN_INT(name,fsym,ssym,args,type,docindex,interactive) \
- XSubr ssym = { type, fsym, MKSTR(name), docindex, MKSTR(interactive) }; \
- VALUE fsym args
-
- #define ADD_SUBR(subr) add_subr(&subr)
- #define ADD_CONST_NUM(name,num) add_const_num(MKSTR(name), num)
- #define INTERN(sym,name) intern_static(&sym, MKSTR(name))
- #define DOC_VAR(sym,docIndex) \
- cmd_put(sym, sym_variable_documentation, make_number(docIndex))
-
-
- /* Macros for ensuring an object is of a certain type
- ie, to ensure first arg `foo' is a string,
- DECLARE1(foo, STRINGP); */
-
- #define DECLARE(n,x,t) \
- do { \
- if(! t(x)) \
- { \
- signal_arg_error(x, n); \
- return(NULL); \
- } \
- } while(0)
-
- #define DECLARE1(x,t) DECLARE(1,x,t)
- #define DECLARE2(x,t) DECLARE(2,x,t)
- #define DECLARE3(x,t) DECLARE(3,x,t)
- #define DECLARE4(x,t) DECLARE(4,x,t)
- #define DECLARE5(x,t) DECLARE(5,x,t)
-
- #define ARG1 (find_member_by_index(args, 1))
- #define ARG2 (find_member_by_index(args, 2))
- #define ARG3 (find_member_by_index(args, 3))
- #define ARG4 (find_member_by_index(args, 4))
- #define ARG(n) (find_member_by_index(args, n))
-
-
- /* Macros for interrupt handling */
-
- #ifndef TEST_INT
- # define TEST_INT do { ; } while(0)
- #endif
-
- #define INT_P (throw_value != NULL)
-
- #endif /* _LISP_H */
-