home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / c / xlisp21w / sources / xldmem.h < prev    next >
Encoding:
C/C++ Source or Header  |  1993-02-07  |  12.2 KB  |  347 lines
  1. /* xldmem.h - dynamic memory definitions */
  2. /*      Copyright (c) 1987, by David Michael Betz
  3.         All Rights Reserved
  4.         Permission is granted for unrestricted non-commercial use       */
  5.  
  6. /* small fixnum range */
  7. #define SFIXMIN         (-128)
  8. #define SFIXMAX         255
  9. #define SFIXSIZE        384
  10.  
  11. /* character range */
  12. #define CHARMIN         0
  13. #define CHARMAX         255
  14. #define CHARSIZE        256
  15.  
  16. /* new node access macros */
  17. #define ntype(x)        ((x)->n_type)
  18.  
  19. /* cons access macros */
  20. #define car(x)          ((x)->n_car)
  21. #define cdr(x)          ((x)->n_cdr)
  22. #define rplaca(x,y)     ((x)->n_car = (y))
  23. #define rplacd(x,y)     ((x)->n_cdr = (y))
  24.  
  25. /* symbol access macros */
  26. #define getvalue(x)      ((x)->n_vdata[0])
  27. #define setvalue(x,v)    ((x)->n_vdata[0] = (v))
  28. #define getfunction(x)   ((x)->n_vdata[1])
  29. #define setfunction(x,v) ((x)->n_vdata[1] = (v))
  30. #define getplist(x)      ((x)->n_vdata[2])
  31. #define setplist(x,v)    ((x)->n_vdata[2] = (v))
  32. #define getpname(x)      ((x)->n_vdata[3])
  33. #define setpname(x,v)    ((x)->n_vdata[3] = (v))
  34. #define SYMSIZE         4
  35.  
  36.  
  37. /* closure access macros */
  38. #define getname(x)      ((x)->n_vdata[0])
  39. #define setname(x,v)    ((x)->n_vdata[0] = (v))
  40. #define gettype(x)      ((x)->n_vdata[1])
  41. #define settype(x,v)    ((x)->n_vdata[1] = (v))
  42. #define getargs(x)      ((x)->n_vdata[2])
  43. #define setargs(x,v)    ((x)->n_vdata[2] = (v))
  44. #define getoargs(x)     ((x)->n_vdata[3])
  45. #define setoargs(x,v)   ((x)->n_vdata[3] = (v))
  46. #define getrest(x)      ((x)->n_vdata[4])
  47. #define setrest(x,v)    ((x)->n_vdata[4] = (v))
  48. #define getkargs(x)     ((x)->n_vdata[5])
  49. #define setkargs(x,v)   ((x)->n_vdata[5] = (v))
  50. #define getaargs(x)     ((x)->n_vdata[6])
  51. #define setaargs(x,v)   ((x)->n_vdata[6] = (v))
  52. #define getbody(x)      ((x)->n_vdata[7])
  53. #define setbody(x,v)    ((x)->n_vdata[7] = (v))
  54. #define getenvi(x)      ((x)->n_vdata[8])
  55. #define setenvi(x,v)    ((x)->n_vdata[8] = (v))
  56. #define getfenv(x)      ((x)->n_vdata[9])
  57. #define setfenv(x,v)    ((x)->n_vdata[9] = (v))
  58. #define getlambda(x)    ((x)->n_vdata[10])
  59. #define setlambda(x,v)  ((x)->n_vdata[10] = (v))
  60. #define CLOSIZE         11
  61.  
  62. /* vector access macros */
  63. #define getsize(x)      ((x)->n_vsize)
  64. #define getelement(x,i) ((x)->n_vdata[i])
  65. #define setelement(x,i,v) ((x)->n_vdata[i] = (v))
  66.  
  67. /* object access macros */
  68. #define getclass(x)     ((x)->n_vdata[0])
  69. #define getivar(x,i)    ((x)->n_vdata[i+1])
  70. #define setivar(x,i,v)  ((x)->n_vdata[i+1] = (v))
  71.  
  72. /* subr/fsubr access macros */
  73. #define getsubr(x)      ((x)->n_subr)
  74. #define getoffset(x)    ((x)->n_offset)
  75.  
  76. /* fixnum/flonum/char access macros */
  77. #define getfixnum(x)    ((x)->n_fixnum)
  78. #define getflonum(x)    ((x)->n_flonum)
  79. #define getchcode(x)    ((x)->n_chcode)
  80.  
  81. #ifdef RATIOS
  82. /* rational number access macros */
  83. #define getnumer(x)     ((x)->n_numer)
  84. #define getdenom(x)     ((x)->n_denom)
  85. #endif
  86.  
  87. /* string access macros */
  88. #define getstring(x)    ((x)->n_string)
  89. #define getslength(x)   ((x)->n_strlen)
  90. /* the following functions were TAA modifications */
  91. #define getstringch(x,i) (((unsigned char XFAR *)((x)->n_string))[i])
  92. #define setstringch(x,i,v) ((x)->n_string[i] = (char)(v))
  93.  
  94. /* file stream access macros */
  95. #define getfile(x)      ((x)->n_fp)
  96. #define setfile(x,v)    ((x)->n_fp = (v))
  97. #define getsavech(x)    ((x)->n_savech)
  98. #define setsavech(x,v)  ((x)->n_savech = (v))
  99.  
  100. /* unnamed stream access macros */
  101. #define gethead(x)      ((x)->n_car)
  102. #define sethead(x,v)    ((x)->n_car = (v))
  103. #define gettail(x)      ((x)->n_cdr)
  104. #define settail(x,v)    ((x)->n_cdr = (v))
  105.  
  106. /* node types */
  107. #define FREE    0
  108. #define SUBR    1
  109. #define FSUBR   2
  110. #define CONS    3
  111. #define FIXNUM  4
  112. #define FLONUM  5
  113. #define STRING  6
  114. #define STREAM  7
  115. #define CHAR    8
  116. #define USTREAM 9
  117. #ifdef RATIOS
  118. #define RATIO   10
  119. #endif
  120. #define ARRAY   16      /* arrayed types */
  121. #define SYMBOL  (ARRAY+1)
  122. #define OBJECT  (ARRAY+2)
  123. #define VECTOR  (ARRAY+3)
  124. #define CLOSURE (ARRAY+4)
  125. #define STRUCT  (ARRAY+5)
  126. #ifdef COMPLX
  127. #define COMPLEX (ARRAY+6)
  128. #endif
  129. #define TYPEFIELD 0x1f
  130. /* subr/fsubr node */
  131. #define n_subr          n_info.n_xsubr.xs_subr
  132. #define n_offset        n_info.n_xsubr.xs_offset
  133.  
  134. /* cons node */
  135. #define n_car           n_info.n_xcons.xc_car
  136. #define n_cdr           n_info.n_xcons.xc_cdr
  137.  
  138. /* fixnum node */
  139. #define n_fixnum        n_info.n_xfixnum.xf_fixnum
  140.  
  141. /* flonum node */
  142. #define n_flonum        n_info.n_xflonum.xf_flonum
  143. /* character node */
  144. #define n_chcode        n_info.n_xchar.xc_chcode
  145.  
  146. /* string node */
  147. #define n_string        n_info.n_xstring.xs_string
  148. #define n_strlen        n_info.n_xstring.xs_length
  149.  
  150. /* stream node */
  151. #define n_fp            n_info.n_xstream.xs_fp
  152. #define n_savech        n_info.n_xstream.xs_savech
  153.  
  154. #define S_READING       1   /* File is in reading mode */
  155. #define S_WRITING       2   /* file is in writing mode */
  156. #define S_FORREADING    4   /* File open for reading */
  157. #define S_FORWRITING    8   /* file open for writing */
  158. #define S_BINARY        16  /* file is binary file */
  159.  
  160. #define n_sflags        n_info.n_xstream.xs_flags
  161. #define n_cpos          n_info.n_xstream.xs_cpos
  162.  
  163. #ifdef RATIOS
  164. /* rational number node */
  165. #define n_numer         n_info.n_xratio.xf_numer
  166. #define n_denom         n_info.n_xratio.xf_denom
  167. #endif
  168.  
  169. /* vector/object node */
  170. #define n_vsize         n_info.n_xvector.xv_size
  171. #define n_vdata         n_info.n_xvector.xv_data
  172. #ifndef ALIGN32
  173. #define n_spflags       n_info.n_xvector.xv_flags
  174. #endif
  175.  
  176. /* node structure */
  177. typedef struct node {
  178. /* 32 bit compilers that pack structures will do better with
  179.    these chars at the end  */
  180. #ifndef ALIGN32
  181.     char n_type;                /* type of node */
  182. #endif
  183.     union ninfo {               /* value */
  184.         struct xsubr {          /* subr/fsubr node */
  185. #ifdef ANSI
  186.         struct node XFAR*(*xs_subr)(void);   /* function pointer */
  187. #else
  188.         struct node XFAR*(*xs_subr)();   /* function pointer */
  189. #endif
  190.             int xs_offset;              /* offset into funtab */
  191.         } n_xsubr;
  192.         struct xcons {          /* cons node */
  193.         struct node XFAR*xc_car;     /* the car pointer */
  194.         struct node XFAR*xc_cdr;     /* the cdr pointer */
  195.         } n_xcons;
  196.         struct xfixnum {        /* fixnum node */
  197.             FIXTYPE xf_fixnum;          /* fixnum value */
  198.         } n_xfixnum;
  199.         struct xflonum {        /* flonum node */
  200.             FLOTYPE xf_flonum;          /* flonum value */
  201.         } n_xflonum;
  202.         struct xchar {          /* character node */
  203.             int xc_chcode;              /* character code */
  204.         } n_xchar;
  205. #ifdef RATIOS
  206.         struct xratio {         /* rational number (ratio) node */
  207.             FIXTYPE xf_numer, xf_denom; /* numerator and denominator */
  208.         } n_xratio;
  209. #endif
  210.         struct xstring {        /* string node */
  211.             unsigned xs_length;         /* string length */
  212.         char XFAR *xs_string;            /* string pointer */
  213.         } n_xstring;
  214.         struct xstream {        /* stream node */
  215.             FILEP xs_fp;                /* the file pointer */
  216.             unsigned char xs_savech;    /* lookahead character */
  217.             char xs_flags;              /* read/write mode flags */
  218.             short xs_cpos;              /* character position in line */
  219.         } n_xstream;
  220.         struct xvector {        /* vector/object/symbol/structure node */
  221.             int xv_size;                /* vector size */
  222.         struct node XFAR * XFAR *xv_data;     /* vector data */
  223. #ifndef ALIGN32
  224.             char xv_flags;      /* constant and special symbol flags */
  225. #endif
  226.         } n_xvector;
  227.         /* $putpatch.c$: "MODULE_XLDMEM_H_NINFO" */
  228.     } n_info;
  229. #ifdef ALIGN32
  230.     char n_type;                /* type of node */
  231.     char n_spflags;
  232. #endif
  233. } XFAR *LVAL;
  234.  
  235. /* memory segment structure definition */
  236. typedef struct segment {
  237.     int sg_size;
  238.     struct segment XFAR *sg_next;
  239.     struct node sg_nodes[1];
  240. } SEGMENT;
  241.  
  242. /* memory allocation functions */
  243. #ifdef ANSI
  244. extern void gc(void);               /* do a garbage collect */
  245. extern SEGMENT XFAR *newsegment(int n);  /* create a new segment */
  246. extern LVAL cons(LVAL x, LVAL y);   /* (cons x y) */
  247. extern LVAL cvsymbol(char *pname);  /* convert a string to a symbol */
  248. extern LVAL cvstring(char XFAR *str);    /* convert a string */
  249. extern LVAL cvfile(FILEP fp, int flags);    /* convert a FILEP to a file */
  250. extern LVAL cvsubr(LVAL (*fcn)(void), int type, int offset);
  251.                                 /* convert a function to a subr/fsubr */
  252. #ifdef JMAC
  253. extern LVAL Cvfixnum(FIXTYPE n);    /* convert a fixnum */
  254. extern LVAL Cvchar(int n);          /* convert a character */
  255. #else
  256. extern LVAL cvfixnum(FIXTYPE n);    /* convert a fixnum */
  257. extern LVAL cvchar(int n);          /* convert a character */
  258. #endif
  259. extern LVAL cvflonum(FLOTYPE n);    /* convert a flonum */
  260.  
  261. #ifdef RATIOS
  262. extern LVAL cvratio(FIXTYPE n, FIXTYPE d);  /* convert a ratio */
  263. #endif
  264.  
  265. extern LVAL newstring(unsigned size);   /* create a new string */
  266. extern LVAL newvector(unsigned size);   /* create a new vector */
  267. extern LVAL newobject(LVAL cls, int size);  /* create a new object */
  268. extern LVAL newclosure(LVAL name, LVAL type, LVAL env, LVAL fenv);
  269.                                     /* create a new closure */
  270. extern LVAL newustream(void);       /* create a new unnamed stream */
  271. extern LVAL newstruct(LVAL type, int size); /* create a new structure */
  272. #ifdef COMPLX
  273. extern LVAL newcomplex(LVAL r, LVAL i);     /* create a new complex number */
  274. extern LVAL newicomplex(FIXTYPE r, FIXTYPE i);      
  275. extern LVAL newdcomplex(FLOTYPE r, FLOTYPE i);
  276. #endif
  277. extern void defconstant(LVAL sym, LVAL val);
  278. #else   /* not ANSI */
  279. extern VOID gc();               /* do a garbage collect */
  280. extern SEGMENT *newsegment();   /* create a new segment */
  281. extern LVAL cons();             /* (cons x y) */
  282. extern LVAL cvsymbol();         /* convert a string to a symbol */
  283. extern LVAL cvstring();         /* convert a string */
  284. extern LVAL cvfile();           /* convert a FILEP to a file */
  285. extern LVAL cvsubr();           /* convert a function to a subr/fsubr */
  286. #ifdef JMAC
  287. extern LVAL Cvfixnum();         /* convert a fixnum */
  288. extern LVAL Cvchar();           /* convert a character */
  289. #else
  290. extern LVAL cvfixnum();         /* convert a fixnum */
  291. extern LVAL cvchar();           /* convert a character */
  292. #endif
  293. extern LVAL cvflonum();         /* convert a flonum */
  294. #ifdef RATIOS
  295. extern LVAL cvratio();
  296. #endif
  297.  
  298. extern LVAL newstring();        /* create a new string */
  299. extern LVAL newvector();        /* create a new vector */
  300. extern LVAL newobject();        /* create a new object */
  301. extern LVAL newclosure();       /* create a new closure */
  302. extern LVAL newustream();       /* create a new unnamed stream */
  303. extern LVAL newstruct();        /* create a new structure */
  304. #ifdef COMPLX
  305. extern LVAL newcomplex();       /* create a new complex number */
  306. extern LVAL newicomplex();      
  307. extern LVAL newdcomplex();
  308. #endif
  309. #endif
  310.  
  311. #define F_SPECIAL   1
  312. #define F_CONSTANT  2
  313. #define F_NORMAL    0
  314.  
  315. #define setsvalue(s,v)  (setvalue(s,v), setsflags(s, F_SPECIAL))
  316. #define setsflags(x,c)  ((x)->n_spflags = (c))
  317. #define constantp(x)  ((x)->n_spflags & F_CONSTANT)
  318. #define specialp(x) ((x)->n_spflags & F_SPECIAL)
  319.  
  320. #ifdef JMAC
  321. /* Speed ups, reduce function calls for fixed characters and numbers       */
  322. /* Speed is exeptionaly noticed on machines with a large instruction cache */
  323. /* No size effects here (JonnyG) */
  324.  
  325. extern SEGMENT XFAR *fixseg, XFAR *charseg;
  326. extern FIXTYPE _tfixed;
  327. extern int _tint;
  328.  
  329. #define cvfixnum(n) ((_tfixed = n), \
  330.                 ((_tfixed > SFIXMIN && _tfixed < SFIXMAX) ? \
  331.                 &fixseg->sg_nodes[(int)_tfixed-SFIXMIN] : \
  332.                 Cvfixnum(_tfixed)))
  333.  
  334. #if (CHARMIN == 0)  /* eliminate a comparison */
  335. #define cvchar(c) ((_tint = c), \
  336.                 (((unsigned)_tint) <= CHARMAX ? \
  337.                         &charseg->sg_nodes[_tint-CHARMIN] : \
  338.                 Cvchar(_tint)))
  339. #else
  340. #define cvchar(c) ((_tint = c), \
  341.                 ((_tint >= CHARMIN && _tint <= CHARMAX) ? \
  342.                         &charseg->sg_nodes[_tint-CHARMIN] : \
  343.                 Cvchar(_tint)))
  344. #endif
  345. #endif
  346. /* $putpatch.c$: "MODULE_XLDMEM_H_GLOBALS" */
  347.