home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / new / util / edit / jade / src / values.c < prev    next >
C/C++ Source or Header  |  1994-10-04  |  24KB  |  1,049 lines
  1. /* values.c -- Handling of Lisp data (includes garbage collection)
  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. #include "jade.h"
  21. #include "jade_protos.h"
  22.  
  23. #include <string.h>
  24. #include <stdlib.h>
  25. #include <assert.h>
  26.  
  27. #ifdef NEED_MEMORY_H
  28. # include <memory.h>
  29. #endif
  30.  
  31. /* #define GC_MONITOR_STK */
  32.  
  33. #define STATIC_SMALL_NUMBERS 256
  34.  
  35. _PR int value_cmp(VALUE, VALUE);
  36. _PR void princ_val(VALUE, VALUE);
  37. _PR void print_val(VALUE, VALUE);
  38. _PR int nil_cmp(VALUE, VALUE);
  39. _PR VALUE make_string(int);
  40. _PR VALUE string_dupn(const u_char *, int);
  41. _PR VALUE string_dup(const u_char *);
  42. _PR int string_cmp(VALUE, VALUE);
  43. _PR bool set_string_len(VALUE, long);
  44. _PR VALUE make_number(long);
  45. _PR int number_cmp(VALUE, VALUE);
  46. _PR int ptr_cmp(VALUE, VALUE);
  47. _PR void cons_free(VALUE);
  48. _PR int cons_cmp(VALUE, VALUE);
  49. _PR VALUE list_1(VALUE);
  50. _PR VALUE list_2(VALUE, VALUE);
  51. _PR VALUE list_3(VALUE, VALUE, VALUE);
  52. _PR VALUE list_4(VALUE, VALUE, VALUE, VALUE);
  53. _PR VALUE list_5(VALUE, VALUE, VALUE, VALUE, VALUE);
  54. _PR VALUE make_vector(int);
  55. _PR VALUE make_lpos(POS *);
  56. _PR VALUE make_lpos2(long, long);
  57. _PR int lpos_cmp(VALUE, VALUE);
  58. _PR void lpos_prin(VALUE, VALUE);
  59. _PR int vector_cmp(VALUE, VALUE);
  60.  
  61. _PR void mark_static(VALUE *);
  62. _PR void mark_value(VALUE);
  63.  
  64. _PR void values_init (void);
  65. _PR void values_init2(void);
  66. _PR void values_kill (void);
  67.  
  68. ValClass ValueClasses[] = {
  69.     { string_cmp, string_princ, string_print, MKSTR("string") },
  70.     { string_cmp, string_princ, string_print, MKSTR("string") },
  71.     { number_cmp, lisp_prin, lisp_prin, MKSTR("number") },
  72.     { cons_cmp, lisp_prin, lisp_prin, MKSTR("cons") },
  73.     { vector_cmp, lisp_prin, lisp_prin, MKSTR("vector") },
  74.     { symbol_cmp, symbol_princ, symbol_print, MKSTR("symbol") },
  75.     { mark_cmp, mark_prin, mark_prin, MKSTR("mark") },
  76.     { lpos_cmp, lpos_prin, lpos_prin, MKSTR("pos") },
  77.     { ptr_cmp, lisp_prin, lisp_prin, MKSTR("var") },
  78.     { ptr_cmp, lisp_prin, lisp_prin, MKSTR("subr-0") },
  79.     { ptr_cmp, lisp_prin, lisp_prin, MKSTR("subr-1") },
  80.     { ptr_cmp, lisp_prin, lisp_prin, MKSTR("subr-2") },
  81.     { ptr_cmp, lisp_prin, lisp_prin, MKSTR("subr-3") },
  82.     { ptr_cmp, lisp_prin, lisp_prin, MKSTR("subr-4") },
  83.     { ptr_cmp, lisp_prin, lisp_prin, MKSTR("subr-5") },
  84.     { ptr_cmp, lisp_prin, lisp_prin, MKSTR("subr-n") },
  85.     { ptr_cmp, lisp_prin, lisp_prin, MKSTR("special-form") },
  86.     { ptr_cmp, buffer_prin, buffer_prin, MKSTR("buffer") },
  87.     { ptr_cmp, window_prin, window_prin, MKSTR("window") },
  88.     { file_cmp, file_prin, file_prin, MKSTR("file") },
  89. #ifdef HAVE_SUBPROCESSES
  90.     { ptr_cmp, proc_prin, proc_prin, MKSTR("process") },
  91. #else
  92.     { nil_cmp, lisp_prin, lisp_prin, MKSTR("process") },
  93. #endif
  94.     { ptr_cmp, glyphtable_prin, glyphtable_prin, MKSTR("glyph-table") },
  95.     { nil_cmp, lisp_prin, lisp_prin, MKSTR("void") },
  96. };
  97.  
  98. int
  99. value_cmp(VALUE v1, VALUE v2)
  100. {
  101.     if(v1 && v2)
  102.     {
  103.     /* If the two objects are the same object then they must be
  104.        equivalent :-) */
  105.     return(v1 == v2 ? 0 : VALUE_CMP(v1, v2));
  106.     }
  107.     return(1);
  108. }
  109.  
  110. void
  111. princ_val(VALUE strm, VALUE val)
  112. {
  113.     if(val)
  114.     PRINC_VAL(strm, val);
  115. }
  116.  
  117. void
  118. print_val(VALUE strm, VALUE val)
  119. {
  120.     if(val)
  121.     PRINT_VAL(strm, val);
  122. }
  123.  
  124. int
  125. nil_cmp(VALUE val1, VALUE val2)
  126. {
  127.     if(VTYPE(val1) == VTYPE(val2))
  128.     return(0);
  129.     return(1);
  130. }
  131.  
  132. static StrMem lisp_strmem;
  133. _PR VALUE null_string;
  134. VALUE null_string = MKSTR("");
  135.  
  136. /* Return a string object with room for exactly LEN characters. No extra
  137.    byte is allocated for a zero terminator; do this manually if required. */
  138. VALUE
  139. make_string(int len)
  140. {
  141.     DynamicString *str;
  142.     int memlen = DSTR_SIZE(len);
  143.     str = sm_alloc(&lisp_strmem, memlen);
  144.     if(str)
  145.     {
  146.     str->ds_Length = len - 1;
  147.     str->ds_Mem[0] = V_DynamicString;
  148.     data_after_gc += memlen;
  149.     return(VAL(&str->ds_Mem[0]));
  150.     }
  151.     return(NULL);
  152. }
  153.  
  154. VALUE
  155. string_dupn(const u_char *src, int slen)
  156. {
  157.     String *dst = VSTRING(make_string(slen + 1));
  158.     if(dst)
  159.     {
  160.     memcpy(dst->str_Mem + 1, src, slen);
  161.     dst->str_Mem[slen+1] = 0;
  162.     }
  163.     return(VAL(dst));
  164. }
  165.  
  166. VALUE
  167. string_dup(const u_char * src)
  168. {
  169.     return(string_dupn(src, strlen(src)));
  170. }
  171.  
  172. int
  173. string_cmp(VALUE v1, VALUE v2)
  174. {
  175.     if(STRINGP(v1) && STRINGP(v2))
  176.     return(strcmp(VSTR(v1), VSTR(v2)));
  177.     return(1);
  178. }
  179.  
  180. static void
  181. string_sweep(void)
  182. {
  183.     int bucket;
  184.     MemChunk *mlc;
  185.     for(bucket = 0; bucket < NUMBUCKETS; bucket++)
  186.     {
  187.     MemChunk **freelist = &lisp_strmem.sm_MemBuckets[bucket].mbu_FreeList;
  188.     MemBlock *mbl = (MemBlock *)lisp_strmem.sm_MemBuckets[bucket].mbu_MemBlocks.mlh_Head;
  189.     MemBlock *nxt;
  190.     int chnksiz = MCHNK_SIZE((bucket + 1) * GRAIN);
  191.     int numchnks = lisp_strmem.sm_ChunksPerBlock[bucket];
  192.     *freelist = NULL;
  193.     while((nxt = (MemBlock *)mbl->mbl_Node.mln_Succ))
  194.     {
  195.         MemChunk *mc = mbl->mbl_Chunks;
  196.         int j;
  197.         for(j = 0; j < numchnks; j++)
  198.         {
  199.         if(mc->mc_BlkType != MBT_FREE)
  200.         {
  201.             register DynamicString *ds = (DynamicString *)mc->mc_Mem.mem;
  202.             if(ds->ds_Mem[0] & GC_MARK_BIT)
  203.             ds->ds_Mem[0] &= ~GC_MARK_BIT;
  204.             else
  205.             {
  206.             mc->mc_BlkType = MBT_FREE;
  207.             mc->mc_Mem.nextfree = *freelist;
  208.             *freelist = mc;
  209.             }
  210.         }
  211.         mc = (MemChunk *)((char *)mc + chnksiz);
  212.         }
  213.         mbl = nxt;
  214.     }
  215.     }
  216.     mlc = lisp_strmem.sm_MallocChain;
  217.     lisp_strmem.sm_MallocChain = NULL;
  218.     while(mlc)
  219.     {
  220.     MemChunk *nxtmlc = mlc->mc_Header.next;
  221.     register DynamicString *ds = (DynamicString *)mlc->mc_Mem.mem;
  222.     if(ds->ds_Mem[0] == V_DynamicString)
  223.         myfree(mlc);
  224.     else
  225.     {
  226.         ds->ds_Mem[0] = V_DynamicString;
  227.         mlc->mc_Header.next = lisp_strmem.sm_MallocChain;
  228.         lisp_strmem.sm_MallocChain = mlc;
  229.     }
  230.     mlc = nxtmlc;
  231.     }
  232. }
  233.  
  234. /* Sets the length-field of the dynamic string STR to LEN. */
  235. bool
  236. set_string_len(VALUE str, long len)
  237. {
  238.     if(VTYPEP(str, V_DynamicString))
  239.     {
  240.     DSTRING_HDR(str)->ds_Length = len;
  241.     return(TRUE);
  242.     }
  243.     return(FALSE);
  244. }
  245.  
  246. static NumberBlk *number_block_chain;
  247. static Number *number_freelist;
  248. static int allocated_numbers, used_numbers;
  249.  
  250. #ifdef STATIC_SMALL_NUMBERS
  251. static Number small_numbers[STATIC_SMALL_NUMBERS];
  252. #endif
  253.  
  254. VALUE
  255. make_number(long n)
  256. {
  257.     Number *num;
  258. #ifdef STATIC_SMALL_NUMBERS
  259.     if((n < STATIC_SMALL_NUMBERS) && (n >= 0))
  260.     return(VAL(&small_numbers[n]));
  261. #endif
  262.     if(!(num = number_freelist))
  263.     {
  264.     NumberBlk *nb = mymalloc(sizeof(NumberBlk));
  265.     if(nb)
  266.     {
  267.         int i;
  268.         allocated_numbers += NUMBERBLK_SIZE;
  269.         nb->nb_Next = number_block_chain;
  270.         number_block_chain = nb;
  271.         for(i = 0; i < (NUMBERBLK_SIZE - 1); i++)
  272.         nb->nb_Numbers[i].num_Data.next = &nb->nb_Numbers[i + 1];
  273.         nb->nb_Numbers[i].num_Data.next = number_freelist;
  274.         number_freelist = nb->nb_Numbers;
  275.     }
  276.     num = number_freelist;
  277.     }
  278.     number_freelist = num->num_Data.next;
  279.     num->num_Type = V_Number;
  280.     num->num_Data.number = n;
  281.     used_numbers++;
  282.     data_after_gc += sizeof(Number);
  283.     return(VAL(num));
  284. }
  285.  
  286. static void
  287. number_sweep(void)
  288. {
  289.     NumberBlk *nb = number_block_chain;
  290.     int i;
  291.     number_freelist = NULL;
  292.     used_numbers = 0;
  293.     while(nb)
  294.     {
  295.     NumberBlk *nxt = nb->nb_Next;
  296.     for(i = 0; i < NUMBERBLK_SIZE; i++)
  297.     {
  298.         if(!GC_MARKEDP(VAL(&nb->nb_Numbers[i])))
  299.         {
  300.         nb->nb_Numbers[i].num_Data.next = number_freelist;
  301.         number_freelist = &nb->nb_Numbers[i];
  302.         }
  303.         else
  304.         {
  305.         GC_CLR(VAL(&nb->nb_Numbers[i]));
  306.         used_numbers++;
  307.         }
  308.     }
  309.     nb = nxt;
  310.     }
  311. #ifdef STATIC_SMALL_NUMBERS
  312.     for(i = 0; i < STATIC_SMALL_NUMBERS; i++)
  313.     GC_CLR(VAL(&small_numbers[i]));
  314. #endif
  315. }
  316.  
  317. int
  318. number_cmp(VALUE v1, VALUE v2)
  319. {
  320.     if(VTYPE(v1) == VTYPE(v2))
  321.     retu