home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / lang / xlisp.sha / xlisp.h < prev    next >
Encoding:
C/C++ Source or Header  |  1985-02-17  |  6.7 KB  |  261 lines
  1. /* xlisp - a small subset of lisp */
  2.  
  3. /* system specific definitions */
  4. #define UNIX
  5.  
  6. #ifdef AZTEC
  7. #include "stdio.h"
  8. #include "setjmp.h"
  9. #else
  10. #include <stdio.h>
  11. #include <setjmp.h>
  12. #include <ctype.h>
  13. #endif
  14.  
  15. /* NNODES    number of nodes to allocate in each request */
  16. /* TDEPTH    trace stack depth */
  17. /* FORWARD    type of a forward declaration (usually "") */
  18. /* LOCAL    type of a local function (usually "static") */
  19.  
  20. /* for the Computer Innovations compiler */
  21. #ifdef CI
  22. #define NNODES        1000
  23. #define TDEPTH        500
  24. #endif
  25.  
  26. /* for the CPM68K compiler */
  27. #ifdef CPM68K
  28. #define NNODES        1000
  29. #define TDEPTH        500
  30. #define LOCAL
  31. #define AFMT        "%lx"
  32. #undef NULL
  33. #define NULL        (char *)0
  34. #endif
  35.  
  36. /* for the DeSmet compiler */
  37. #ifdef DESMET
  38. #define NNODES        1000
  39. #define TDEPTH        500
  40. #define LOCAL
  41. #define getc(fp)    getcx(fp)
  42. #define putc(ch,fp)    putcx(ch,fp)
  43. #define EOF        -1
  44. #endif
  45.  
  46. /* for the MegaMax compiler */
  47. #ifdef MEGAMAX
  48. #define NNODES        200
  49. #define TDEPTH        100
  50. #define LOCAL
  51. #define AFMT        "%lx"
  52. #define TSTKSIZE    (4 * TDEPTH)
  53. #endif
  54.  
  55. /* for the VAX-11 C compiler */
  56. #ifdef vms
  57. #define NNODES        2000
  58. #define TDEPTH        1000
  59. #endif
  60.  
  61. /* for the DECUS C compiler */
  62. #ifdef decus
  63. #define NNODES        200
  64. #define TDEPTH        100
  65. #define FORWARD        extern
  66. #endif
  67.  
  68. /* for unix compilers */
  69. #ifdef unix
  70. #define NNODES        200
  71. #define TDEPTH        100
  72. #endif
  73.  
  74. /* for the AZTEC C compiler */
  75. #ifdef AZTEC
  76. #define NNODES        200
  77. #define TDEPTH        100
  78. #define getc(fp)    agetc(fp)
  79. #define putc(ch,fp)    aputc(ch,fp)
  80. #endif
  81.  
  82. /* default important definitions */
  83. #ifndef NNODES
  84. #define NNODES        200
  85. #endif
  86. #ifndef TDEPTH
  87. #define TDEPTH        100
  88. #endif
  89. #ifndef FORWARD
  90. #define FORWARD
  91. #endif
  92. #ifndef LOCAL
  93. #define LOCAL        static
  94. #endif
  95. #ifndef AFMT
  96. #define AFMT        "%x"
  97. #endif
  98. #ifndef TSTKSIZE
  99. #define TSTKSIZE    (sizeof(NODE *) * TDEPTH)
  100. #endif
  101.  
  102. /* useful definitions */
  103. #define TRUE    1
  104. #define FALSE    0
  105. #define NIL    (NODE *)0
  106.  
  107. /* program limits */
  108. #define STRMAX        100        /* maximum length of a string constant */
  109.     
  110. /* node types */
  111. #define FREE    0
  112. #define SUBR    1
  113. #define FSUBR    2
  114. #define LIST    3
  115. #define SYM    4
  116. #define INT    5
  117. #define STR    6
  118. #define OBJ    7
  119. #define FPTR    8
  120.  
  121. /* node flags */
  122. #define MARK    1
  123. #define LEFT    2
  124.  
  125. /* string types */
  126. #define DYNAMIC    0
  127. #define STATIC    1
  128.  
  129. /* new node access macros */
  130. #define ntype(x)    ((x)->n_type)
  131. #define atom(x)        ((x) == NIL || (x)->n_type != LIST)
  132. #define null(x)        ((x) == NIL)
  133. #define listp(x)    ((x) == NIL || (x)->n_type == LIST)
  134. #define consp(x)    ((x) && (x)->n_type == LIST)
  135. #define subrp(x)    ((x) && (x)->n_type == SUBR)
  136. #define fsubrp(x)    ((x) && (x)->n_type == FSUBR)
  137. #define stringp(x)    ((x) && (x)->n_type == STR)
  138. #define symbolp(x)    ((x) && (x)->n_type == SYM)
  139. #define filep(x)    ((x) && (x)->n_type == FPTR)
  140. #define objectp(x)    ((x) && (x)->n_type == OBJ)
  141. #define fixp(x)        ((x) && (x)->n_type == INT)
  142. #define car(x)        ((x)->n_car)
  143. #define cdr(x)        ((x)->n_cdr)
  144. #define rplaca(x,y)    ((x)->n_car = (y))
  145. #define rplacd(x,y)    ((x)->n_cdr = (y))
  146.  
  147. /* symbol node */
  148. #define n_symplist    n_info.n_xsym.xsy_plist
  149. #define n_symvalue    n_info.n_xsym.xsy_value
  150.  
  151. /* subr/fsubr node */
  152. #define n_subr        n_info.n_xsubr.xsu_subr
  153.  
  154. /* list node */
  155. #define n_car        n_info.n_xlist.xl_car
  156. #define n_cdr        n_info.n_xlist.xl_cdr
  157. #define n_ptr        n_info.n_xlist.xl_car
  158.  
  159. /* integer node */
  160. #define n_int        n_info.n_xint.xi_int
  161.  
  162. /* string node */
  163. #define n_str        n_info.n_xstr.xst_str
  164. #define n_strtype    n_info.n_xstr.xst_type
  165.  
  166. /* object node */
  167. #define n_obclass    n_info.n_xobj.xo_obclass
  168. #define n_obdata    n_info.n_xobj.xo_obdata
  169.  
  170. /* file pointer node */
  171. #define n_fp        n_info.n_xfptr.xf_fp
  172. #define n_savech    n_info.n_xfptr.xf_savech
  173.  
  174. /* node structure */
  175. typedef struct node {
  176.     char n_type;        /* type of node */
  177.     char n_flags;        /* flag bits */
  178.     union {            /* value */
  179.     struct xsym {        /* symbol node */
  180.         struct node *xsy_plist;    /* symbol plist - (name . plist) */
  181.         struct node *xsy_value;    /* the current value */
  182.     } n_xsym;
  183.     struct xsubr {        /* subr/fsubr node */
  184.         struct node *(*xsu_subr)();    /* pointer to an internal routine */
  185.     } n_xsubr;
  186.     struct xlist {        /* list node (cons) */
  187.         struct node *xl_car;    /* the car pointer */
  188.         struct node *xl_cdr;    /* the cdr pointer */
  189.     } n_xlist;
  190.     struct xint {        /* integer node */
  191.         int xi_int;            /* integer value */
  192.     } n_xint;
  193.     struct xstr {        /* string node */
  194.         int xst_type;        /* string type */
  195.         char *xst_str;        /* string pointer */
  196.     } n_xstr;
  197.     struct xobj {        /* object node */
  198.         struct node *xo_obclass;    /* class of object */
  199.         struct node *xo_obdata;    /* instance data */
  200.     } n_xobj;
  201.     struct xfptr {        /* file pointer node */
  202.         FILE *xf_fp;        /* the file pointer */
  203.         int xf_savech;        /* lookahead character for input files */
  204.     } n_xfptr;
  205.     } n_info;
  206. } NODE;
  207.  
  208. /* execution context flags */
  209. #define CF_GO        1
  210. #define CF_RETURN    2
  211. #define CF_THROW    4
  212. #define CF_ERROR    8
  213.  
  214. /* execution context */
  215. typedef struct context {
  216.     int c_flags;            /* context type flags */
  217.     struct node *c_expr;        /* expression (type dependant) */
  218.     jmp_buf c_jmpbuf;            /* longjmp context */
  219.     struct context *c_xlcontext;    /* old value of xlcontext */
  220.     struct node *c_xlstack;        /* old value of xlstack */
  221.     struct node *c_xlenv,*c_xlnewenv;    /* old values of xlenv and xlnewenv */
  222.     int c_xltrace;            /* old value of xltrace */
  223. } CONTEXT;
  224.  
  225. /* function table entry structure */
  226. struct fdef {
  227.     char *f_name;            /* function name */
  228.     int f_type;                /* function type SUBR/FSUBR */
  229.     struct node *(*f_fcn)();        /* function code */
  230. };
  231.  
  232. /* memory segment structure definition */
  233. struct segment {
  234.     int sg_size;
  235.     struct segment *sg_next;
  236.     struct node sg_nodes[1];
  237. };
  238.  
  239. /* external procedure declarations */
  240. extern struct node *xleval();        /* evaluate an expression */
  241. extern struct node *xlapply();        /* apply a function to arguments */
  242. extern struct node *xlevlist();        /* evaluate a list of arguments */
  243. extern struct node *xlarg();        /* fetch an argument */
  244. extern struct node *xlevarg();        /* fetch and evaluate an argument */
  245. extern struct node *xlmatch();        /* fetch an typed argument */
  246. extern struct node *xlevmatch();    /* fetch and evaluate a typed arg */
  247. extern struct node *xlsend();        /* send a message to an object */
  248. extern struct node *xlenter();        /* enter a symbol */
  249. extern struct node *xlsenter();        /* enter a symbol with a static pname */
  250. extern struct node *xlintern();        /* intern a symbol */
  251. extern struct node *xlmakesym();    /* make an uninterned symbol */
  252. extern struct node *xlsave();        /* generate a stack frame */
  253. extern struct node *xlobsym();        /* find an object's class or instance
  254.                        variable */
  255. extern struct node *xlgetprop();    /* get the value of a property */
  256. extern char *xlsymname();        /* get the print name of a symbol */
  257.  
  258. extern struct node *newnode();        /* allocate a new node */
  259. extern char *stralloc();        /* allocate string space */
  260. extern char *strsave();            /* make a safe copy of a string */
  261.