home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / util / jade-3.0.lha / Jade / src / lisp.h < prev    next >
Encoding:
C/C++ Source or Header  |  1994-04-16  |  10.0 KB  |  372 lines
  1. /* lisp.h -- Data structures/objects for Lisp
  2.    Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. This file is part of Jade.
  5.  
  6. Jade is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. Jade is distributed in the hope that it will be useful, but
  12. WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with Jade; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #ifndef _LISP_H
  21. #define _LISP_H
  22.  
  23. #ifndef _VALUE_H
  24. # include "value.h"
  25. #endif
  26.  
  27. /*
  28.  * These numbers weren't just plucked from the air, they make the blocks
  29.  * of objects fit as close as possible into powers of 2 sized blocks.
  30.  */
  31. #define CONSBLK_SIZE    682
  32. #define SYMBOLBLK_SIZE    170
  33. #define NUMBERBLK_SIZE    127
  34. #define LPOSBLK_SIZE    170
  35.  
  36. #define OBSIZE        509
  37.  
  38. enum ValueType
  39. {
  40.     /* Static strings are C string constants, use the macro MKSTR to make
  41.        them from a normal string constant.  */
  42.     V_StaticString = 0,
  43.     V_String,
  44.     V_Number,
  45. #define V_Char V_Number
  46.     V_Cons,
  47.     V_Vector,
  48.     V_Symbol,
  49.     V_Mark,
  50.     V_Pos,
  51.     V_Keytab,
  52.     V_Keylist,
  53.     /* SUBR with one argument, this arg is new value of variable to set the
  54.        var, or NULL to make it return the variable's value.  */
  55.     V_Var,
  56.     V_Subr0,
  57.     V_Subr1,
  58.     V_Subr2,
  59.     V_Subr3,
  60.     V_Subr4,
  61.     V_Subr5,
  62.     V_SubrN,
  63.     V_SF,
  64.     V_Buffer,
  65. #define V_TX V_Buffer
  66.     V_Window,
  67.     V_File,
  68.     V_Process
  69. };
  70.  
  71. #define VPTR(v)        (v)
  72. #define VSTRING(v)    ((String *)(v))
  73. #define VSTR(v)        (VSTRING(v)->str_Data)
  74. #define VNUMBER(v)    ((Number *)(v))
  75. #define VNUM(v)        (VNUMBER(v)->num_Data.number)
  76. #define VCHAR(v)    VNUM(v)
  77. #define VCONS(v)    ((Cons *)(v))
  78. #define VCAR(v)        (VCONS(v)->cn_Car)
  79. #define VCDR(v)        (VCONS(v)->cn_Cdr)
  80. #define VVECT(v)    ((Vector *)(v))
  81. #define VSYM(v)        ((Symbol *)(v))
  82. #define VMARK(v)    ((Mark *)(v))
  83. #define VLPOS(v)    ((LPos *)(v))
  84. #define VPOS(v)        (VLPOS(v)->lp_Data.pos)
  85. #define VKEYTAB(v)    ((Keytab *)(v))
  86. #define VKEYLIST(v)    ((Keylist *)(v))
  87. #define VXSUBR(v)    ((XSubr *)(v))
  88. #define VSUBR(v)    ((Subr *)(v))
  89. #define VSUBR0FUN(v)    (VSUBR(v)->subr_Fun.fun0)
  90. #define VSUBR1FUN(v)    (VSUBR(v)->subr_Fun.fun1)
  91. #define VSUBR2FUN(v)    (VSUBR(v)->subr_Fun.fun2)
  92. #define VSUBR3FUN(v)    (VSUBR(v)->subr_Fun.fun3)
  93. #define VSUBR4FUN(v)    (VSUBR(v)->subr_Fun.fun4)
  94. #define VSUBR5FUN(v)    (VSUBR(v)->subr_Fun.fun5)
  95. #define VSUBRNFUN(v)    (VSUBR(v)->subr_Fun.fun1)
  96. #define VSFFUN(v)    (VSUBR(v)->subr_Fun.fun1)
  97. #define VVARFUN(v)    (VSUBR(v)->subr_Fun.fun1)
  98. #define VTX(v)        ((TX *)(v))
  99. #define VBUFFER(v)    VTX(v)
  100. #define VFILE(v)    ((LFile *)(v))
  101. #define VPROC(v)    ((struct Proc *)(v))
  102. #define VWIN(v)        ((VW *)(v))
  103. #define VOBJHDR(v)    ((ObjectHdr *)(v))
  104.  
  105. #define VTYPE(v)    (VOBJHDR(v)->oh_Type)
  106. #define VTYPEP(v,t)    (VTYPE(v) == (t))
  107. #define NILP(v)        ((v) == sym_nil)
  108. #define STRINGP(v)    (VTYPEP(v, V_StaticString) || VTYPEP(v, V_String))
  109. #define NUMBERP(v)    VTYPEP(v, V_Number)
  110. #define CHARP(v)    NUMBERP(v)
  111. #define CONSP(v)    VTYPEP(v, V_Cons)
  112. #define VECTORP(v)    VTYPEP(v, V_Vector)
  113. #define SYMBOLP(v)    VTYPEP(v, V_Symbol)
  114. #define BUFFERP(v)    VTYPEP(v, V_Buffer)
  115. #define POSP(v)        VTYPEP(v, V_Pos)
  116. #define MARKP(v)    VTYPEP(v, V_Mark)
  117. #define KEYTABP(v)    VTYPEP(v, V_Keytab)
  118. #define KEYLISTP(v)    VTYPEP(v, V_Keylist)
  119. #define FILEP(v)    VTYPEP(v, V_File)
  120. #define PROCESSP(v)    VTYPEP(v, V_Process)
  121. #define WINDOWP(v)    (VTYPEP(v, V_Window) && VWIN(v)->vw_Window)
  122.  
  123. #define GC_MARK_BIT    0x80
  124. #define GC_MARK(v)    (VTYPE(v) & GC_MARK_BIT)
  125. #define GC_MARKEDP(v)    (GC_MARK(v) != 0)
  126. #define GC_SET(v)    (VTYPE(v) |= GC_MARK_BIT)
  127. #define GC_CLR(v)    (VTYPE(v) &= ~GC_MARK_BIT)
  128. #define MARKVAL(v)    do { if((v) && !GC_MARKEDP(v)) markvalue(v); } while(0)
  129.  
  130. typedef struct ValClass {
  131.     /*
  132.      * compares two values, rc is similar to strcmp()
  133.      */
  134.     int      (*vc_Cmp)(VALUE val1, VALUE val2);
  135.     /*
  136.      * prints a textual representation of the object, not necessarily in
  137.      * a read'able format
  138.      */
  139.     void  (*vc_Princ)(VALUE stream, VALUE obj);
  140.     /*
  141.      * prints a textual representation of the object, if possible in
  142.      * a read'able format
  143.      */
  144.     void  (*vc_Print)(VALUE stream, VALUE obj);
  145.     /*
  146.      * this is the name of the type
  147.      */
  148.     VALUE   vc_Name;
  149. } ValClass;
  150.  
  151. /*
  152.  * The following is an array of VALCLASS structs, the array index corresponds
  153.  * to the VTF_* numbers
  154.  */
  155. extern ValClass ValueClasses[];
  156.  
  157. /*
  158.  * These are also defined as functions (lower-case'd names)...
  159.  */
  160. #define VALUECMP(v1,v2) ValueClasses[VTYPE(v1)].vc_Cmp(v1,v2)
  161. #define PRINCVAL(s,v)    ValueClasses[VTYPE(v)].vc_Princ(s,v)
  162. #define PRINTVAL(s,v)    ValueClasses[VTYPE(v)].vc_Print(s,v)
  163. /*
  164.  * except these which aren't
  165.  */
  166. #define VALNAME(v)    (ValueClasses[VTYPE(v)].vc_Name)
  167.  
  168. /*
  169.  * The first byte of all Lisp objects is defined as,
  170.  * bits 0 -> 6 = type of object (ie V_*)
  171.  * bit 7 = GC mark bit (only when garbage collection is in progress).
  172.  */
  173. typedef struct {
  174.     u_char        oh_Type;
  175. } ObjectHdr;
  176.  
  177. typedef struct {
  178.     u_char        str_Type;
  179.     u_char        str_Data[0];
  180. } String;
  181. #define STR_SIZE(s) ((s) + 1)
  182.  
  183. /* Make a static STRING from a normal C string constant, ie,
  184.    MKSTR("foo") -> "\0foo"  */
  185. #define MKSTR(s) ((String *)("\0" s))
  186.  
  187. /* Get the beginning of the STRING struct from a (char *)  */
  188. #define STRING_HDR(s) ((String *)((char *)(s)-1))
  189.  
  190. typedef struct _Number {
  191.     u_char        num_Type;
  192.     union {
  193.     long        number;
  194.     struct _Number *next;
  195.     }            num_Data;
  196. } Number;
  197. typedef struct _NumberBlk {
  198.     struct _NumberBlk *nb_Next;
  199.     Number        nb_Numbers[NUMBERBLK_SIZE];
  200. } NumberBlk;
  201.  
  202. typedef struct {
  203.     u_char        cn_Type;
  204.     VALUE        cn_Car;
  205.     VALUE        cn_Cdr;
  206. } Cons;
  207. typedef struct _ConsBlk {
  208.     struct _ConsBlk *cb_Next;
  209.     Cons        cb_Cons[CONSBLK_SIZE];
  210. } ConsBlk;
  211.  
  212. typedef struct _Vector {
  213.     u_char        vc_Type;
  214.     struct _Vector *vc_Next;
  215.     int            vc_Size;
  216.     VALUE        vc_Array[0];
  217. } Vector;
  218. #define VECT_SIZE(s) ((sizeof(VALUE) * (s)) + sizeof(Vector))
  219.  
  220. typedef struct _Symbol {
  221.     u_char    sym_Type;
  222.     u_char    sym_Flags;
  223.     struct _Symbol *sym_Next;    /* next symbol in obarray bucket */
  224.     VALUE    sym_Name;
  225.     VALUE    sym_Value;
  226.     VALUE    sym_Function;
  227.     VALUE    sym_PropList;
  228. } Symbol;
  229. #define SF_CONSTANT    1
  230. /* Means that the symbol's value may be in the buffer-local storage, if so
  231.    then that occurrence takes precedence. */
  232. #define SF_BUFFER_LOCAL 2
  233. #define SF_WIN_LOCAL    4    /* Same, but for windows.  */
  234. #define SF_DEBUG    8    /* Break on next lisp form. */
  235. #define SF_INTERNED    16    /* Symbol has been interned. */
  236.  
  237. typedef struct _SymbolBlk {
  238.     struct _SymbolBlk *sb_Next;
  239.     Symbol       sb_Symbols[SYMBOLBLK_SIZE];
  240. } SymbolBlk;
  241.  
  242. typedef union _LPos {
  243.     struct {
  244.     u_char        type;
  245.     struct POS    pos;
  246.     }            lp_Data;
  247.     union _LPos       *lp_Next;
  248. } LPos;
  249. typedef struct _LPosBlk {
  250.     struct _LPosBlk *lb_Next;
  251.     LPos        lb_Pos[LPOSBLK_SIZE];
  252. } LPosBlk;
  253.  
  254. typedef struct _LFile {
  255.     u_char        lf_Type;
  256.     u_char        lf_Flags;
  257.     struct _LFile  *lf_Next;
  258.     VALUE        lf_Name;
  259.     FILE       *lf_File;
  260. } LFile;
  261. #define LFF_DONT_CLOSE 1
  262.  
  263. typedef struct {
  264.     u_char        subr_Type;
  265.     union {
  266.     VALUE          (*fun0)(void);
  267.     VALUE          (*fun1)(VALUE);
  268.     VALUE          (*fun2)(VALUE, VALUE);
  269.     VALUE          (*fun3)(VALUE, VALUE, VALUE);
  270.     VALUE          (*fun4)(VALUE, VALUE, VALUE, VALUE);
  271.     VALUE          (*fun5)(VALUE, VALUE, VALUE, VALUE, VALUE);
  272.     }            subr_Fun;
  273.     VALUE        subr_Name;
  274.     int            subr_DocIndex;
  275. } Subr;
  276. typedef struct {
  277.     u_char        subr_Type;
  278.     void       *subr_Fun;
  279.     VALUE        subr_Name;
  280.     int            subr_DocIndex;
  281. } XSubr;
  282.  
  283.  
  284. #define LIST_1(v1)           cmd_cons(v1, sym_nil)
  285. #define LIST_2(v1,v2)           cmd_cons(v1, LIST_1(v2))
  286. #define LIST_3(v1,v2,v3)       cmd_cons(v1, LIST_2(v2, v3))
  287. #define LIST_4(v1,v2,v3,v4)    cmd_cons(v1, LIST_3(v2, v3, v4))
  288. #define LIST_5(v1,v2,v3,v4,v5) cmd_cons(v1, LIST_4(v2, v3, v4, v5))
  289.  
  290. /*
  291.  * Keeps a backtrace of all lisp functions called. NOT primitives.
  292.  */
  293. struct LispCall {
  294.     struct LispCall *lc_Next;
  295.     VALUE        lc_Fun;
  296.     VALUE        lc_Args;
  297.     /* t if `lc_Args' is list of *evalled* arguments.  */
  298.     VALUE           lc_ArgsEvalledP;
  299. };
  300.  
  301. /*
  302.  * A stack of these providing additional entry points for the mark phase of
  303.  * garbage collection.
  304.  */
  305. typedef struct _GCVAL {
  306.     VALUE       *gcv_Value;
  307.     struct _GCVAL  *gcv_Next;
  308. } GCVAL;
  309.  
  310. typedef struct _GCVALN {
  311.     VALUE       *gcv_First;
  312.     int            gcv_N;
  313.     struct _GCVALN *gcv_Next;
  314. } GCVALN;
  315.  
  316. #define POPGC (GCVStack = GCVStack->gcv_Next)
  317. #define PUSHGC(gcv, val)       \
  318.     do {               \
  319.     (gcv).gcv_Value = &(val);  \
  320.     (gcv).gcv_Next = GCVStack; \
  321.     GCVStack = &(gcv);       \
  322.     } while(0)
  323.  
  324. #define POPGCN (GCVNStack = GCVNStack->gcv_Next)
  325. #define PUSHGCN(gcv, valp, n)        \
  326.     do {                \
  327.     (gcv).gcv_First = (valp);   \
  328.     (gcv).gcv_N = (n);        \
  329.     (gcv).gcv_Next = GCVNStack; \
  330.     GCVNStack = &(gcv);        \
  331.     } while(0)
  332.  
  333. /*
  334.  * Macros for defining functions and their SUBR structures
  335.  */
  336. #define DEFUN(name,fsym,ssym,args,type,docindex)    \
  337.     XSubr ssym = { type, fsym, MKSTR(name), docindex };    \
  338.     VALUE fsym args
  339.  
  340. #define ADD_SUBR(subr) addsubr(&subr)
  341. #define ADD_CONST_NUM(name,num) addconstnum(MKSTR(name), num)
  342. #define INTERN(sym,name) internstatic(&sym, MKSTR(name))
  343. #define DOC_VAR(sym,docIndex) \
  344.     cmd_put(sym, sym_variable_documentation, newnumber(docIndex))
  345.  
  346. /*
  347.  * Macros for ensuring an object is of a certain type
  348.  * ie, to ensure first arg `foo' is a string,
  349.  *   DECLARE1(foo, STRINGP);
  350.  */
  351. #define DECLARE(n,x,t) \
  352.     do { \
  353.     if(! t(x)) \
  354.     { \
  355.         signalargerror(x, n); \
  356.         return(NULL); \
  357.     } \
  358.     } while(0)
  359. #define DECLARE1(x,t)        DECLARE(1,x,t)
  360. #define DECLARE2(x,t)        DECLARE(2,x,t)
  361. #define DECLARE3(x,t)        DECLARE(3,x,t)
  362. #define DECLARE4(x,t)        DECLARE(4,x,t)
  363. #define DECLARE5(x,t)        DECLARE(5,x,t)
  364.  
  365. #define ARG1    (findmemberbyindex(args, 1))
  366. #define ARG2    (findmemberbyindex(args, 2))
  367. #define ARG3    (findmemberbyindex(args, 3))
  368. #define ARG4    (findmemberbyindex(args, 4))
  369. #define ARG(n)    (findmemberbyindex(args, n))
  370.  
  371. #endif /* _LISP_H */
  372.