File: finalize.c

package info (click to toggle)
rscheme 0.7.2-1.1
  • links: PTS
  • area: main
  • in suites: slink
  • size: 10,672 kB
  • ctags: 12,430
  • sloc: lisp: 37,104; ansic: 29,763; cpp: 2,630; sh: 1,677; makefile: 568; yacc: 202; lex: 175; perl: 33
file content (130 lines) | stat: -rw-r--r-- 3,127 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
/*-----------------------------------------------------------------*-C-*---
 * File:    handc/runtime/finalize.c
 *
 *          Copyright (C)1997 Donovan Kolbly <d.kolbly@rscheme.org>
 *          as part of the RScheme project, licensed for free use.
 *          See <http://www.rscheme.org/> for the latest information.
 *
 * File version:     1.6
 * File mod date:    1997.11.29 23:10:50
 * System build:     v0.7.2, 97.12.21
 *
 * Purpose:          Support for finalization and weak pointers
 *------------------------------------------------------------------------*
 * Notes:
 *      This support is GC-independent, supplying the client (language)
 *      side definitions for `safe_for_object_is_dead' and the internal
 *      function mark_as_finalizable and found_weak_slot
 *------------------------------------------------------------------------*/

#include <stdlib.h>
#include <rscheme/intrs.h>
#include <rscheme/osglue.h>
#include <rscheme/gcserver.h>
#include <rscheme/smemory.h>
#include <rscheme/scheme.h>

struct obj_list {
  obj      *contents;
  unsigned  count;
  unsigned  capacity;
};

static struct obj_list fzable = { NULL, 0, 0 };
static struct obj_list wkslot = { NULL, 0, 0 };


void shrink_list( struct obj_list *lst )
{
}

void add_to_list( struct obj_list *lst, obj item )
{
  if (lst->count >= lst->capacity)
    {
      if (lst->count == 0)
	{
	  lst->capacity = 16;
	  lst->contents = (obj *)malloc( sizeof( obj ) * 16 );
	}
      else
	{
	  lst->capacity *= 2;
	  lst->contents = (obj *)realloc( lst->contents, 
					  sizeof( obj ) * lst->capacity );
	}
    }
  lst->contents[lst->count++] = item;
}

void mark_as_finalizable( obj item )
{
  add_to_list( &fzable, item );
}

/* returns YES if the GC can flip now.  If this function returns YES,
 * the GC _will_ flip (we send the GC_FLIP signal to the scheme system)
 */

rs_bool gc_cycle_finish_ok( void )
{
  unsigned i;
  obj fzing_list = NIL_OBJ;
  unsigned fzing_cnt = 0;

  for (i=0; i<fzable.count;)
    {
      if (is_object_dead( PTR_TO_GCPTR(fzable.contents[i])) )
	{
	  fzing_list = cons( fzable.contents[i], fzing_list );
	  fzable.contents[i] = fzable.contents[--fzable.count];
	  fzing_cnt++;
	}
      else
	i++;
    }
  if (!EQ(fzing_list,NIL_OBJ))
    {
      /* signal the scheme system */

      struct RSSIG_info sig;
      sig.signum = RSSIG_FINALIZE;
      sig.data.finalize.finalize_list = fzing_list;
      sig.data.finalize.count = fzing_cnt;

      os_enqueue_sig( &sig );
      return NO;
    }
  else
    {
      /* send the `gc flipped' signal */

      struct RSSIG_info sig;
      sig.signum = RSSIG_GC_FLIP;
      os_enqueue_sig( &sig );

      /* nil out weak pointers */

      if (wkslot.count < (wkslot.capacity / 2))
	shrink_list( &wkslot );

      for (i=0; i<wkslot.count; i++)
	{
	  obj *vp, v;

	  vp = (obj *)OBJ_TO_RAW_PTR(wkslot.contents[i]);
	  v = *vp;
	  if (OBJ_ISA_PTR(v) && is_object_dead(PTR_TO_GCPTR(v)))
	    {
	      *vp = FALSE_OBJ;
	    }
	}
      wkslot.count = 0;
      return YES;
    }
}

void found_weak_slot( obj in, obj *slot )
{
  add_to_list( &wkslot, RAW_PTR_TO_OBJ(slot) );
}